ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.11

Browse Source
This commit is contained in:
Steve Dower
2021-03-30 00:51:39 +01:00
parent 3bb8e3e086
commit 1aadb2455c
923 changed files with 79104 additions and 62616 deletions
Download Patch File Download Diff File Expand all files Collapse all files

153
generic/tclParse.c
View File

@@ -167,6 +167,8 @@ static int ParseTokens(const char *src, int numBytes, int mask,
int flags, Tcl_Parse *parsePtr);
static int ParseWhiteSpace(const char *src, int numBytes,
int *incompletePtr, char *typePtr);
static int ParseHex(const char *src, int numBytes,
int *resultPtr);
/*
*----------------------------------------------------------------------
@@ -234,19 +236,19 @@ Tcl_ParseCommand(
* NULL, then no error message is provided. */
const char *start, /* First character of string containing one or
* more Tcl commands. */
register int numBytes, /* Total number of bytes in string. If < 0,
int numBytes, /* Total number of bytes in string. If < 0,
* the script consists of all bytes up to the
* first null character. */
int nested, /* Non-zero means this is a nested command:
* close bracket should be considered a
* command terminator. If zero, then close
* bracket has no special meaning. */
register Tcl_Parse *parsePtr)
Tcl_Parse *parsePtr)
/* Structure to fill in with information about
* the parsed command; any previous
* information in the structure is ignored. */
{
register const char *src; /* Points to current character in the
const char *src; /* Points to current character in the
* command. */
char type; /* Result returned by CHAR_TYPE(*src). */
Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
@@ -257,6 +259,10 @@ Tcl_ParseCommand(
* point to char after terminating one. */
int scanned;
if (numBytes < 0 && start) {
numBytes = strlen(start);
}
TclParseInit(interp, start, numBytes, parsePtr);
if ((start == NULL) && (numBytes != 0)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -264,10 +270,6 @@ Tcl_ParseCommand(
}
return TCL_ERROR;
}
if (numBytes < 0) {
numBytes = strlen(start);
}
TclParseInit(interp, start, numBytes, parsePtr);
parsePtr->commentStart = NULL;
parsePtr->commentSize = 0;
parsePtr->commandStart = NULL;
@@ -682,14 +684,14 @@ TclIsBareword(
static int
ParseWhiteSpace(
const char *src, /* First character to parse. */
register int numBytes, /* Max number of bytes to scan. */
int numBytes, /* Max number of bytes to scan. */
int *incompletePtr, /* Set this boolean memory to true if parsing
* indicates an incomplete command. */
char *typePtr) /* Points to location to store character type
* of character that ends run of whitespace */
{
register char type = TYPE_NORMAL;
register const char *p = src;
char type = TYPE_NORMAL;
const char *p = src;
while (1) {
while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
@@ -754,7 +756,7 @@ TclParseAllWhiteSpace(
/*
*----------------------------------------------------------------------
*
* TclParseHex --
* ParseHex --
*
* Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing
* \x and \u escape sequences). At most numBytes bytes are scanned.
@@ -774,7 +776,7 @@ TclParseAllWhiteSpace(
*/
int
TclParseHex(
ParseHex(
const char *src, /* First character to parse. */
int numBytes, /* Max number of byes to scan */
int *resultPtr) /* Points to storage provided by caller where
@@ -782,12 +784,12 @@ TclParseHex(
* conversion is to be written. */
{
int result = 0;
register const char *p = src;
const char *p = src;
while (numBytes--) {
unsigned char digit = UCHAR(*p);
if (!isxdigit(digit) || (result > 0x10fff)) {
if (!isxdigit(digit) || (result > 0x10FFF)) {
break;
}
@@ -840,8 +842,7 @@ TclParseBackslash(
* written. At most TCL_UTF_MAX bytes will be
* written there. */
{
register const char *p = src+1;
Tcl_UniChar unichar = 0;
const char *p = src+1;
int result;
int count;
char buf[TCL_UTF_MAX] = "";
@@ -870,7 +871,7 @@ TclParseBackslash(
count = 2;
switch (*p) {
/*
* Note: in the conversions below, use absolute values (e.g., 0xa)
* Note: in the conversions below, use absolute values (e.g., 0xA)
* rather than symbolic values (e.g. \n) that get converted by the
* compiler. It's possible that compilers on some platforms will do
* the symbolic conversions differently, which could result in
@@ -884,25 +885,25 @@ TclParseBackslash(
result = 0x8;
break;
case 'f':
result = 0xc;
result = 0xC;
break;
case 'n':
result = 0xa;
result = 0xA;
break;
case 'r':
result = 0xd;
result = 0xD;
break;
case 't':
result = 0x9;
break;
case 'v':
result = 0xb;
result = 0xB;
break;
case 'x':
count += TclParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result);
count += ParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result);
if (count == 2) {
/*
* No hexadigits -> This is just "x".
* No hexdigits -> This is just "x".
*/
result = 'x';
@@ -910,25 +911,42 @@ TclParseBackslash(
/*
* Keep only the last byte (2 hex digits).
*/
result = (unsigned char) result;
result = UCHAR(result);
}
break;
case 'u':
count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
count += ParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
if (count == 2) {
/*
* No hexadigits -> This is just "u".
* No hexdigits -> This is just "u".
*/
result = 'u';
#if TCL_UTF_MAX > 3
} else if (((result & 0xFC00) == 0xD800) && (count == 6)
&& (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) {
/* If high surrogate is immediately followed by a low surrogate
* escape, combine them into one character. */
int low;
int count2 = ParseHex(p+7, 4, &low);
if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) {
result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000;
count += count2 + 2;
}
#endif
}
break;
case 'U':
count += TclParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result);
count += ParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result);
if (count == 2) {
/*
* No hexadigits -> This is just "U".
* No hexdigits -> This is just "U".
*/
result = 'U';
#if TCL_UTF_MAX > 3
} else if ((result & ~0x7FF) == 0xD800) {
/* Upper or lower surrogate, not allowed in this syntax. */
result = 0xFFFD;
#endif
}
break;
case '\n':
@@ -974,16 +992,15 @@ TclParseBackslash(
* #217987] test subst-3.2
*/
if (Tcl_UtfCharComplete(p, numBytes - 1)) {
count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
if (TclUCS4Complete(p, numBytes - 1)) {
count = TclUtfToUCS4(p, &result) + 1; /* +1 for '\' */
} else {
char utfBytes[TCL_UTF_MAX];
char utfBytes[8];
memcpy(utfBytes, p, (size_t) (numBytes - 1));
memcpy(utfBytes, p, numBytes - 1);
utfBytes[numBytes - 1] = '\0';
count = TclUtfToUniChar(utfBytes, &unichar) + 1;
count = TclUtfToUCS4(utfBytes, &result) + 1;
}
result = unichar;
break;
}
@@ -991,13 +1008,12 @@ TclParseBackslash(
if (readPtr != NULL) {
*readPtr = count;
}
count = Tcl_UniCharToUtf(result, dst);
#if TCL_UTF_MAX > 3
if ((result >= 0xD800) && (count < 3)) {
count += Tcl_UniCharToUtf(-1, dst + count);
#if TCL_UTF_MAX < 4
if (result > 0xFFFF) {
result = 0xFFFD;
}
#endif
return count;
return TclUCS4ToUtf(result, dst);
}
/*
@@ -1021,12 +1037,12 @@ TclParseBackslash(
static int
ParseComment(
const char *src, /* First character to parse. */
register int numBytes, /* Max number of bytes to scan. */
int numBytes, /* Max number of bytes to scan. */
Tcl_Parse *parsePtr) /* Information about parse in progress.
* Updated if parsing indicates an incomplete
* command. */
{
register const char *p = src;
const char *p = src;
while (numBytes) {
char type;
@@ -1105,8 +1121,8 @@ ParseComment(
static int
ParseTokens(
register const char *src, /* First character to parse. */
register int numBytes, /* Max number of bytes to scan. */
const char *src, /* First character to parse. */
int numBytes, /* Max number of bytes to scan. */
int mask, /* Specifies when to stop parsing. The parse
* stops at the first unquoted character whose
* CHAR_TYPE contains any of the bits in
@@ -1384,7 +1400,7 @@ Tcl_ParseVarName(
* NULL, then no error message is provided. */
const char *start, /* Start of variable substitution string.
* First character must be "$". */
register int numBytes, /* Total number of bytes in string. If < 0,
int numBytes, /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
Tcl_Parse *parsePtr, /* Structure to fill in with information about
@@ -1395,20 +1411,19 @@ Tcl_ParseVarName(
* reinitialize it. */
{
Tcl_Token *tokenPtr;
register const char *src;
const char *src;
int varIndex;
unsigned array;
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
}
if (numBytes < 0) {
if (numBytes < 0 && start) {
numBytes = strlen(start);
}
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
}
/*
* Generate one token for the variable, an additional token for the name,
@@ -1577,13 +1592,13 @@ Tcl_ParseVarName(
const char *
Tcl_ParseVar(
Tcl_Interp *interp, /* Context for looking up variable. */
register const char *start, /* Start of variable substitution. First
const char *start, /* Start of variable substitution. First
* character must be "$". */
const char **termPtr) /* If non-NULL, points to word to fill in with
* character just after last one in the
* variable specifier. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
int code;
Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
@@ -1662,10 +1677,10 @@ Tcl_ParseBraces(
* NULL, then no error message is provided. */
const char *start, /* Start of string enclosed in braces. The
* first character must be {'. */
register int numBytes, /* Total number of bytes in string. If < 0,
int numBytes, /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
register Tcl_Parse *parsePtr,
Tcl_Parse *parsePtr,
/* Structure to fill in with information about
* the string. */
int append, /* Non-zero means append tokens to existing
@@ -1678,19 +1693,18 @@ Tcl_ParseBraces(
* successful. */
{
Tcl_Token *tokenPtr;
register const char *src;
const char *src;
int startIndex, level, length;
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
}
if (numBytes < 0) {
if (numBytes < 0 && start) {
numBytes = strlen(start);
}
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
}
src = start;
startIndex = parsePtr->numTokens;
@@ -1804,7 +1818,7 @@ Tcl_ParseBraces(
*/
{
register int openBrace = 0;
int openBrace = 0;
while (--src > start) {
switch (*src) {
@@ -1815,7 +1829,7 @@ Tcl_ParseBraces(
openBrace = 0;
break;
case '#' :
if (openBrace && TclIsSpaceProc(src[-1])) {
if (openBrace && TclIsSpaceProcM(src[-1])) {
Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp),
": possible unbalanced brace in comment", -1);
goto error;
@@ -1864,10 +1878,10 @@ Tcl_ParseQuotedString(
* NULL, then no error message is provided. */
const char *start, /* Start of the quoted string. The first
* character must be '"'. */
register int numBytes, /* Total number of bytes in string. If < 0,
int numBytes, /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
register Tcl_Parse *parsePtr,
Tcl_Parse *parsePtr,
/* Structure to fill in with information about
* the string. */
int append, /* Non-zero means append tokens to existing
@@ -1879,16 +1893,15 @@ Tcl_ParseQuotedString(
* the quoted string's terminating close-quote
* if the parse succeeds. */
{
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
}
if (numBytes < 0) {
if (numBytes < 0 && start) {
numBytes = strlen(start);
}
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
}
if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL,
parsePtr)) {
@@ -2159,7 +2172,7 @@ TclSubstTokens(
* 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
* this "main script", and the character
* offsets are relative to the 'outerScript'
* as well.
*