summaryrefslogtreecommitdiffstats
path: root/generic/tclParse.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclParse.c')
-rw-r--r--generic/tclParse.c401
1 files changed, 209 insertions, 192 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 2b0dab4..b40b636 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-
+
#include "tclInt.h"
/*
@@ -182,13 +182,13 @@ static int ParseWhiteSpace(const char *src, int numBytes,
*
* TclParseInit --
*
- * Initialize the fields of a Tcl_Parse struct.
+ * Initialize the fields of a Tcl_Parse struct.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * The Tcl_Parse struct pointed to by parsePtr gets initialized.
+ * The Tcl_Parse struct pointed to by parsePtr gets initialized.
*
*----------------------------------------------------------------------
*/
@@ -251,7 +251,7 @@ Tcl_ParseCommand(
* command terminator. If zero, then close
* bracket has no special meaning. */
register Tcl_Parse *parsePtr)
- /* Structure to fill in with information about
+ /* Structure to fill in with information about
* the parsed command; any previous
* information in the structure is ignored. */
{
@@ -496,10 +496,9 @@ Tcl_ParseCommand(
* tokens representing the expanded list.
*/
- const char *listStart;
+ CONST char *listStart;
int growthNeeded = wordIndex + 2*elemCount
- parsePtr->numTokens;
-
parsePtr->numWords += elemCount - 1;
if (growthNeeded > 0) {
TclGrowParseTokenArray(parsePtr, growthNeeded);
@@ -519,7 +518,7 @@ Tcl_ParseCommand(
listStart = nextElem = tokenPtr[1].start;
while (nextElem < listEnd) {
int quoted;
-
+
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
tokenPtr->numComponents = 1;
@@ -629,6 +628,47 @@ TclIsSpaceProc(
/*
*----------------------------------------------------------------------
*
+ * TclIsBareword--
+ *
+ * Report whether byte is one that can be part of a "bareword".
+ * This concept is named in expression parsing, where it determines
+ * what can be a legal function name, but is the same definition used
+ * in determining what variable names can be parsed as variable
+ * substitutions without the benefit of enclosing braces. The set of
+ * ASCII chars that are accepted are the numeric chars ('0'-'9'),
+ * the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_').
+ *
+ * Results:
+ * Returns 1, if byte is in the accepted set of chars, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsBareword(
+ char byte)
+{
+ if (byte < '0' || byte > 'z') {
+ return 0;
+ }
+ if (byte <= '9' || byte >= 'a') {
+ return 1;
+ }
+ if (byte == '_') {
+ return 1;
+ }
+ if (byte < 'A' || byte > 'Z') {
+ return 0;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseWhiteSpace --
*
* Scans up to numBytes bytes starting at src, consuming white space
@@ -673,7 +713,7 @@ ParseWhiteSpace(
if (p[1] != '\n') {
break;
}
- p += 2;
+ p+=2;
if (--numBytes == 0) {
*incompletePtr = 1;
break;
@@ -744,11 +784,11 @@ int
TclParseHex(
const char *src, /* First character to parse. */
int numBytes, /* Max number of byes to scan */
- int *resultPtr) /* Points to storage provided by caller where
- * the character resulting from the
+ Tcl_UniChar *resultPtr) /* Points to storage provided by caller where
+ * the Tcl_UniChar resulting from the
* conversion is to be written. */
{
- int result = 0;
+ Tcl_UniChar result = 0;
register const char *p = src;
while (numBytes--) {
@@ -758,7 +798,7 @@ TclParseHex(
break;
}
- p++;
+ ++p;
result <<= 4;
if (digit >= 'a') {
@@ -783,14 +823,14 @@ TclParseHex(
* sequence as defined by Tcl's parsing rules.
*
* Results:
- * Records at readPtr the number of bytes making up the backslash
- * sequence. Records at dst the UTF-8 encoded equivalent of that
- * backslash sequence. Returns the number of bytes written to dst, at
- * most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results
- * are not needed, but the return value is the same either way.
+ * Records at readPtr the number of bytes making up the backslash
+ * sequence. Records at dst the UTF-8 encoded equivalent of that
+ * backslash sequence. Returns the number of bytes written to dst, at
+ * most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results
+ * are not needed, but the return value is the same either way.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -808,8 +848,7 @@ TclParseBackslash(
* written there. */
{
register const char *p = src+1;
- Tcl_UniChar unichar;
- int result;
+ Tcl_UniChar result;
int count;
char buf[TCL_UTF_MAX];
@@ -907,21 +946,21 @@ TclParseBackslash(
*/
if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
- result = *p - '0';
+ result = (unsigned char)(*p - '0');
p++;
if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
|| (UCHAR(*p) >= '8')) {
break;
}
count = 3;
- result = (result << 3) + (*p - '0');
+ result = (unsigned char)((result << 3) + (*p - '0'));
p++;
if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
|| (UCHAR(*p) >= '8')) {
break;
}
count = 4;
- result = UCHAR((result << 3) + (*p - '0'));
+ result = (unsigned char)((result << 3) + (*p - '0'));
break;
}
@@ -933,15 +972,14 @@ TclParseBackslash(
*/
if (Tcl_UtfCharComplete(p, numBytes - 1)) {
- count = Tcl_UtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
+ count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, p, (size_t) (numBytes - 1));
utfBytes[numBytes - 1] = '\0';
- count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
+ count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
}
- result = unichar;
break;
}
@@ -949,7 +987,7 @@ TclParseBackslash(
if (readPtr != NULL) {
*readPtr = count;
}
- return Tcl_UniCharToUtf(result, dst);
+ return Tcl_UniCharToUtf((int) result, dst);
}
/*
@@ -961,11 +999,11 @@ TclParseBackslash(
* defined by Tcl's parsing rules.
*
* Results:
- * Records in parsePtr information about the parse. Returns the number of
- * bytes consumed.
+ * Records in parsePtr information about the parse. Returns the number of
+ * bytes consumed.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -1118,7 +1156,7 @@ ParseTokens(
}
/*
- * This is a variable reference. Call Tcl_ParseVarName to do all
+ * This is a variable reference. Call Tcl_ParseVarName to do all
* the dirty work of parsing the name.
*/
@@ -1142,14 +1180,15 @@ ParseTokens(
}
/*
- * Command substitution. Call Tcl_ParseCommand recursively (and
+ * Command substitution. Call Tcl_ParseCommand recursively (and
* repeatedly) to parse the nested command(s), then throw away the
* parse information.
*/
src++;
numBytes--;
- nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
+ nestedPtr = (Tcl_Parse *)
+ TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
while (1) {
if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
nestedPtr) != TCL_OK) {
@@ -1295,7 +1334,7 @@ Tcl_FreeParse(
* call to Tcl_ParseCommand. */
{
if (parsePtr->tokenPtr != parsePtr->staticTokens) {
- ckfree(parsePtr->tokenPtr);
+ ckfree((char *) parsePtr->tokenPtr);
parsePtr->tokenPtr = parsePtr->staticTokens;
}
}
@@ -1345,9 +1384,7 @@ Tcl_ParseVarName(
{
Tcl_Token *tokenPtr;
register const char *src;
- unsigned char c;
- int varIndex, offset;
- Tcl_UniChar ch;
+ int varIndex;
unsigned array;
if ((numBytes == 0) || (start == NULL)) {
@@ -1430,22 +1467,12 @@ Tcl_ParseVarName(
tokenPtr->numComponents = 0;
while (numBytes) {
- if (Tcl_UtfCharComplete(src, numBytes)) {
- offset = Tcl_UtfToUniChar(src, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
-
- memcpy(utfBytes, src, (size_t) numBytes);
- utfBytes[numBytes] = '\0';
- offset = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- c = UCHAR(ch);
- if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
- src += offset;
- numBytes -= offset;
+ if (TclIsBareword(*src)) {
+ src += 1;
+ numBytes -= 1;
continue;
}
- if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
+ if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) {
src += 2;
numBytes -= 2;
while (numBytes && (*src == ':')) {
@@ -1546,7 +1573,8 @@ Tcl_ParseVar(
{
register Tcl_Obj *objPtr;
int code;
- Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+ Tcl_Parse *parsePtr = (Tcl_Parse *)
+ TclStackAlloc(interp, sizeof(Tcl_Parse));
if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
TclStackFree(interp, parsePtr);
@@ -1567,6 +1595,7 @@ Tcl_ParseVar(
code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
NULL, 1, NULL, NULL);
+ Tcl_FreeParse(parsePtr);
TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
@@ -1629,7 +1658,7 @@ Tcl_ParseBraces(
* the string consists of all bytes up to the
* first null character. */
register Tcl_Parse *parsePtr,
- /* Structure to fill in with information about
+ /* Structure to fill in with information about
* the string. */
int append, /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
@@ -1830,7 +1859,7 @@ Tcl_ParseQuotedString(
* the string consists of all bytes up to the
* first null character. */
register Tcl_Parse *parsePtr,
- /* Structure to fill in with information about
+ /* Structure to fill in with information about
* the string. */
int append, /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
@@ -1878,42 +1907,33 @@ Tcl_ParseQuotedString(
/*
*----------------------------------------------------------------------
*
- * TclSubstParse --
+ * Tcl_SubstObj --
+ *
+ * This function performs the substitutions specified on the given string
+ * as described in the user documentation for the "subst" Tcl command.
*
- * Token parser used by the [subst] command. Parses the string made up of
- * 'numBytes' bytes starting at 'bytes'. Parsing is controlled by the
- * flags argument to provide support for the -nobackslashes, -nocommands,
- * and -novariables options, as represented by the flag values
- * TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES.
- *
* Results:
- * None.
+ * A Tcl_Obj* containing the substituted string, or NULL to indicate that
+ * an error occurred.
*
* Side effects:
- * The Tcl_Parse struct '*parsePtr' is filled with parse results.
- * The caller is expected to eventually call Tcl_FreeParse() to properly
- * cleanup the value written there.
- *
- * If a parse error occurs, the Tcl_InterpState value '*statePtr' is
- * filled with the state created by that error. When *statePtr is written
- * to, the caller is expected to make the required calls to either
- * Tcl_RestoreInterpState() or Tcl_DiscardInterpState() to dispose of the
- * value written there.
+ * See the user documentation.
*
*----------------------------------------------------------------------
*/
-void
-TclSubstParse(
- Tcl_Interp *interp,
- const char *bytes,
- int numBytes,
- int flags,
- Tcl_Parse *parsePtr,
- Tcl_InterpState *statePtr)
+Tcl_Obj *
+Tcl_SubstObj(
+ Tcl_Interp *interp, /* Interpreter in which substitution occurs */
+ Tcl_Obj *objPtr, /* The value to be substituted. */
+ int flags) /* What substitutions to do. */
{
- int length = numBytes;
- const char *p = bytes;
+ int length, tokensLeft, code;
+ Tcl_Token *endTokenPtr;
+ Tcl_Obj *result, *errMsg = NULL;
+ const char *p = TclGetStringFromObj(objPtr, &length);
+ Tcl_Parse *parsePtr = (Tcl_Parse *)
+ TclStackAlloc(interp, sizeof(Tcl_Parse));
TclParseInit(interp, p, length, parsePtr);
@@ -1925,11 +1945,12 @@ TclSubstParse(
if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) {
/*
- * There was a parse error. Save the interpreter state for possible
- * error reporting later.
+ * There was a parse error. Save the error message for possible
+ * reporting later.
*/
- *statePtr = Tcl_SaveInterpState(interp, TCL_ERROR);
+ errMsg = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errMsg);
/*
* We need to re-parse to get the portion of the string we can [subst]
@@ -1995,10 +2016,10 @@ TclSubstParse(
parsePtr->tokenPtr + parsePtr->numTokens - 2;
if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
- Tcl_Panic("TclSubstParse: programming error");
+ Tcl_Panic("Tcl_SubstObj: programming error");
}
if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
- Tcl_Panic("TclSubstParse: programming error");
+ Tcl_Panic("Tcl_SubstObj: programming error");
}
parsePtr->numTokens -= 2;
}
@@ -2027,7 +2048,7 @@ TclSubstParse(
Tcl_Token *tokenPtr;
const char *lastTerm = parsePtr->term;
- Tcl_Parse *nestedPtr =
+ Tcl_Parse *nestedPtr = (Tcl_Parse *)
TclStackAlloc(interp, sizeof(Tcl_Parse));
while (TCL_OK ==
@@ -2072,8 +2093,63 @@ TclSubstParse(
break;
default:
- Tcl_Panic("bad parse in TclSubstParse: %c", p[length]);
+ Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]);
+ }
+ }
+
+ /*
+ * Next, substitute the parsed tokens just as in normal Tcl evaluation.
+ */
+
+ endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+ tokensLeft = parsePtr->numTokens;
+ code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
+ &tokensLeft, 1, NULL, NULL);
+ if (code == TCL_OK) {
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
+ if (errMsg != NULL) {
+ Tcl_SetObjResult(interp, errMsg);
+ Tcl_DecrRefCount(errMsg);
+ return NULL;
+ }
+ return Tcl_GetObjResult(interp);
+ }
+
+ result = Tcl_NewObj();
+ while (1) {
+ switch (code) {
+ case TCL_ERROR:
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
+ Tcl_DecrRefCount(result);
+ if (errMsg != NULL) {
+ Tcl_DecrRefCount(errMsg);
+ }
+ return NULL;
+ case TCL_BREAK:
+ tokensLeft = 0; /* Halt substitution */
+ default:
+ Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp));
}
+
+ if (tokensLeft == 0) {
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
+ if (errMsg != NULL) {
+ if (code != TCL_BREAK) {
+ Tcl_DecrRefCount(result);
+ Tcl_SetObjResult(interp, errMsg);
+ Tcl_DecrRefCount(errMsg);
+ return NULL;
+ }
+ Tcl_DecrRefCount(errMsg);
+ }
+ return result;
+ }
+
+ code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
+ &tokensLeft, 1, NULL, NULL);
}
}
@@ -2088,13 +2164,13 @@ TclSubstParse(
* non-TCL_OK completion code arises.
*
* Results:
- * The return value is a standard Tcl completion code. The result in
- * interp is the substituted value, or an error message if TCL_ERROR is
- * returned. If tokensLeftPtr is not NULL, then it points to an int where
- * the number of tokens remaining to be processed is written.
+ * The return value is a standard Tcl completion code. The result in
+ * interp is the substituted value, or an error message if TCL_ERROR is
+ * returned. If tokensLeftPtr is not NULL, then it points to an int where
+ * the number of tokens remaining to be processed is written.
*
* Side effects:
- * Can be anything, depending on the types of substitution done.
+ * Can be anything, depending on the types of substitution done.
*
*----------------------------------------------------------------------
*/
@@ -2112,30 +2188,29 @@ TclSubstTokens(
* integer representing the number of tokens
* left to be substituted will be written */
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 by
- * EvalEx() 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 'outerScript'
- * as well.
- *
- * If outerScript == script, then this call is
- * for words in the outer-most script or
- * command. See Tcl_EvalEx and TclEvalObjEx
- * for the places generating arguments for
- * which this is true. */
+ int* clNextOuter, /* Information about an outer context for */
+ CONST char* outerScript) /* continuation line data. This is set by
+ * EvalEx() 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 'outerScript' as well.
+ *
+ * If outerScript == script, then this call is for
+ * words in the outer-most script/command. See
+ * Tcl_EvalEx() and TclEvalObjEx() for the places
+ * generating arguments for which this is true.
+ */
{
Tcl_Obj *result;
int code = TCL_OK;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL, i, adjust;
- int *clPosition = NULL;
- Interp *iPtr = (Interp *) interp;
+ int* clPosition = NULL;
+ Interp* iPtr = (Interp*) interp;
int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
/*
@@ -2152,24 +2227,24 @@ TclSubstTokens(
* 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.
+ * locations of all continuation lines we find in this literal, if
+ * any. The table is extended if needed.
*/
- numCL = 0;
- maxNumCL = 0;
+ numCL = 0;
+ maxNumCL = 0;
isLiteral = 1;
for (i=0 ; i < count; i++) {
- if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
- && (tokenPtr[i].type != TCL_TOKEN_BS)) {
+ if ((tokenPtr[i].type != TCL_TOKEN_TEXT) &&
+ (tokenPtr[i].type != TCL_TOKEN_BS)) {
isLiteral = 0;
break;
}
}
if (isLiteral) {
- maxNumCL = NUM_STATIC_POS;
- clPosition = ckalloc(maxNumCL * sizeof(int));
+ maxNumCL = NUM_STATIC_POS;
+ clPosition = (int*) ckalloc (maxNumCL*sizeof(int));
}
adjust = 0;
@@ -2190,7 +2265,6 @@ TclSubstTokens(
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
@@ -2206,11 +2280,10 @@ TclSubstTokens(
* correction.
*/
- if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
- && (tokenPtr->start[1] == '\n')) {
+ if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') &&
+ (tokenPtr->start[1] == '\n')) {
if (isLiteral) {
int clPos;
-
if (result == 0) {
clPos = 0;
} else {
@@ -2219,18 +2292,19 @@ TclSubstTokens(
if (numCL >= maxNumCL) {
maxNumCL *= 2;
- clPosition = ckrealloc(clPosition,
- maxNumCL * sizeof(int));
+ clPosition = (int*) ckrealloc ((char*)clPosition,
+ maxNumCL*sizeof(int));
}
clPosition[numCL] = clPos;
- numCL++;
+ numCL ++;
}
- adjust++;
+ adjust ++;
}
break;
case TCL_TOKEN_COMMAND: {
- /* TIP #280: Transfer line information to nested command */
+ Interp *iPtr = (Interp *) interp;
+
iPtr->numLevels++;
code = TclInterpReady(interp);
if (code == TCL_OK) {
@@ -2239,27 +2313,21 @@ TclSubstTokens(
*/
int theline;
-
- TclAdvanceContinuations(&line, &clNextOuter,
- tokenPtr->start - outerScript);
+ TclAdvanceContinuations (&line, &clNextOuter,
+ tokenPtr->start - outerScript);
theline = line + adjust;
+ /* TIP #280: Transfer line information to nested command */
code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
0, theline, clNextOuter, outerScript);
-
- TclAdvanceLines(&line, tokenPtr->start+1,
- tokenPtr->start + tokenPtr->size - 1);
-
/*
* Restore flag reset by nested eval for future bracketed
* commands and their cmdframe setup
*/
-
- if (inFile) {
+ if (inFile) {
iPtr->evalFlags |= TCL_EVAL_FILE;
}
}
iPtr->numLevels--;
- TclResetCancellation(interp, 0);
appendObj = Tcl_GetObjResult(interp);
break;
}
@@ -2358,7 +2426,6 @@ TclSubstTokens(
if (code != TCL_ERROR) { /* Keep error message in result! */
if (result != NULL) {
Tcl_SetObjResult(interp, result);
-
/*
* If the code found continuation lines (which implies that this
* word is a literal), then we store the accumulated table of
@@ -2377,7 +2444,7 @@ TclSubstTokens(
*/
if (maxNumCL) {
- ckfree(clPosition);
+ ckfree ((char*) clPosition);
}
} else {
Tcl_ResetResult(interp);
@@ -2496,56 +2563,6 @@ TclObjCommandComplete(
}
/*
- *----------------------------------------------------------------------
- *
- * TclIsLocalScalar --
- *
- * Check to see if a given string is a legal scalar variable name with no
- * namespace qualifiers or substitutions.
- *
- * Results:
- * Returns 1 if the variable is a local scalar.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclIsLocalScalar(
- const char *src,
- int len)
-{
- const char *p;
- const char *lastChar = src + (len - 1);
-
- for (p=src ; p<=lastChar ; p++) {
- if ((CHAR_TYPE(*p) != TYPE_NORMAL)
- && (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
- /*
- * TCL_COMMAND_END is returned for the last character of the
- * string. By this point we know it isn't an array or namespace
- * reference.
- */
-
- return 0;
- }
- if (*p == '(') {
- if (*lastChar == ')') { /* We have an array element */
- return 0;
- }
- } else if (*p == ':') {
- if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
- return 0;
- }
- }
- }
-
- return 1;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
generated by cgit v0.12 at 2025-12-20 23:21:16 (GMT)