diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCompExpr.c | 53 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 5 | ||||
| -rw-r--r-- | generic/tclLoad.c | 95 | ||||
| -rw-r--r-- | generic/tclLoadNone.c | 30 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 22 |
5 files changed, 114 insertions, 91 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index f35038f..03aebe3 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -164,6 +164,8 @@ enum Marks { * "=" is encountered. */ #define INVALID 5 /* A parse error. Used when any punctuation * appears that's not a supported operator. */ +#define COMMENT 6 /* Comment. Lasts to end of line or end of + * expression, whichever comes first. */ /* Leaf lexemes */ @@ -462,7 +464,7 @@ static const unsigned char Lexeme[] = { INVALID /* FS */, INVALID /* GS */, INVALID /* RS */, INVALID /* US */, INVALID /* SPACE */, 0 /* ! or != */, - QUOTED /* " */, INVALID /* # */, + QUOTED /* " */, 0 /* # */, VARIABLE /* $ */, MOD /* % */, 0 /* & or && */, INVALID /* ' */, OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */, @@ -674,9 +676,10 @@ ParseExpr( OpNode *newPtr = NULL; do { - if (size <= UINT_MAX/sizeof(OpNode)) { - newPtr = (OpNode *)attemptckrealloc(nodes, size * sizeof(OpNode)); - } + if (size <= UINT_MAX/sizeof(OpNode)) { + newPtr = (OpNode *) attemptckrealloc(nodes, + size * sizeof(OpNode)); + } } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); if (newPtr == NULL) { @@ -708,6 +711,10 @@ ParseExpr( int b; switch (lexeme) { + case COMMENT: + start += scanned; + numBytes -= scanned; + continue; case INVALID: msg = Tcl_ObjPrintf("invalid character \"%.*s\"", scanned, start); @@ -742,6 +749,32 @@ ParseExpr( } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { lexeme = BOOLEAN; } else { + /* + * Tricky case: see test expr-62.10 + */ + + int scanned2 = scanned; + do { + scanned2 += TclParseAllWhiteSpace( + start + scanned2, numBytes - scanned2); + scanned2 += ParseLexeme( + start + scanned2, numBytes - scanned2, &lexeme, + NULL); + } while (lexeme == COMMENT); + if (lexeme == OPEN_PAREN) { + /* + * Actually a function call, but with obscuring + * comments. Skip to the start of the parentheses. + * Note that we assume that open parentheses are one + * byte long. + */ + + lexeme = FUNCTION; + Tcl_ListObjAppendElement(NULL, funcList, literal); + scanned = scanned2 - 1; + break; + } + Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", (scanned < limit) ? scanned : limit - 3, start, @@ -1894,7 +1927,7 @@ ParseLexeme( storage, if non-NULL. */ { const char *end; - int scanned; + int scanned, size; int ch; Tcl_Obj *literal = NULL; unsigned char byte; @@ -1909,6 +1942,16 @@ ParseLexeme( return 1; } switch (byte) { + case '#': + /* + * Scan forward over the comment contents. + */ + for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) { + byte = UCHAR(start[size]); + } + *lexemePtr = COMMENT; + return size - (byte == '\n'); + case '*': if ((numBytes > 1) && (start[1] == '*')) { *lexemePtr = EXPON; diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index b698c08..71d9f5c 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -1413,4 +1413,9 @@ extern const TclIntStubs *tclIntStubsPtr; # define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage) #endif +#undef TclGuessPackageName +#ifndef TCL_NO_DEPRECATED +# define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0) +#endif + #endif /* _TCLINTDECLS */ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index c143d0a..0d331c6 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -302,60 +302,55 @@ Tcl_LoadObjCmd( if (packageName != NULL) { Tcl_DStringAppend(&pkgName, packageName, -1); } else { - int retc; + Tcl_Obj *splitPtr, *pkgGuessPtr; + int pElements; + const char *pkgGuess; /* * Threading note - this call used to be protected by a mutex. */ - retc = TclGuessPackageName(fullFileName, &pkgName); - if (!retc) { - Tcl_Obj *splitPtr, *pkgGuessPtr; - int pElements; - const char *pkgGuess; - - /* - * The platform-specific code couldn't figure out the module - * name. Make a guess by taking the last element of the file - * name, stripping off any leading "lib", and then using all - * of the alphabetic and underline characters that follow - * that. - */ + /* + * The platform-specific code couldn't figure out the module + * name. Make a guess by taking the last element of the file + * name, stripping off any leading "lib", and then using all + * of the alphabetic and underline characters that follow + * that. + */ - splitPtr = Tcl_FSSplitPath(objv[1], &pElements); - Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); - pkgGuess = Tcl_GetString(pkgGuessPtr); - if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') - && (pkgGuess[2] == 'b')) { - pkgGuess += 3; - } + splitPtr = Tcl_FSSplitPath(objv[1], &pElements); + Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); + pkgGuess = Tcl_GetString(pkgGuessPtr); + if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') + && (pkgGuess[2] == 'b')) { + pkgGuess += 3; + } #ifdef __CYGWIN__ - if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y') - && (pkgGuess[2] == 'g')) { - pkgGuess += 3; - } + else if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y') + && (pkgGuess[2] == 'g')) { + pkgGuess += 3; + } #endif /* __CYGWIN__ */ - for (p = pkgGuess; *p != 0; p += offset) { - offset = TclUtfToUniChar(p, &ch); - if ((ch > 0x100) - || !(isalpha(UCHAR(ch)) /* INTL: ISO only */ - || (UCHAR(ch) == '_'))) { - break; - } - } - if (p == pkgGuess) { - Tcl_DecrRefCount(splitPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't figure out package name for %s", - fullFileName)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", - "WHATPACKAGE", NULL); - code = TCL_ERROR; - goto done; + for (p = pkgGuess; *p != 0; p += offset) { + offset = TclUtfToUniChar(p, &ch); + if ((ch > 0x100) + || !(isalpha(UCHAR(ch)) /* INTL: ISO only */ + || (UCHAR(ch) == '_'))) { + break; } - Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess); + } + if (p == pkgGuess) { Tcl_DecrRefCount(splitPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't figure out package name for %s", + fullFileName)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", + "WHATPACKAGE", NULL); + code = TCL_ERROR; + goto done; } + Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess); + Tcl_DecrRefCount(splitPtr); } /* @@ -1025,7 +1020,7 @@ Tcl_StaticPackage( /* *---------------------------------------------------------------------- * - * TclGetLoadedPackages, TclGetLoadedPackagesEx -- + * TclGetLoadedPackagesEx -- * * This function returns information about all of the files that are * loaded (either in a particular interpreter, or for all interpreters). @@ -1044,18 +1039,6 @@ Tcl_StaticPackage( */ int -TclGetLoadedPackages( - Tcl_Interp *interp, /* Interpreter in which to return information - * or error message. */ - const char *targetName) /* Name of target interpreter or NULL. If - * NULL, return info about all interps; - * otherwise, just return info about this - * interpreter. */ -{ - return TclGetLoadedPackagesEx(interp, targetName, NULL); -} - -int TclGetLoadedPackagesEx( Tcl_Interp *interp, /* Interpreter in which to return information * or error message. */ diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index 6af5c4f..588c2cb 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.c @@ -54,36 +54,6 @@ TclpDlopen( } /* - *---------------------------------------------------------------------- - * - * TclGuessPackageName -- - * - * If the "load" command is invoked without providing a package name, - * this procedure is invoked to try to figure it out. - * - * Results: - * Always returns 0 to indicate that we couldn't figure out a package - * name; generic code will then try to guess the package from the file - * name. A return value of 1 would have meant that we figured out the - * package name and put it in bufPtr. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclGuessPackageName( - const char *fileName, /* Name of file containing package (already - * translated to local form if needed). */ - Tcl_DString *bufPtr) /* Initialized empty dstring. Append package - * name to this if possible. */ -{ - return 0; -} - -/* * These functions are fallbacks if we somehow determine that the platform can * do loading from memory but the user wishes to disable it. They just report * (gracefully) that they fail. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 03577f7..5d4c2ec 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -67,6 +67,8 @@ #undef TclWinNToHS #undef TclStaticPackage #undef Tcl_BackgroundError +#undef TclGuessPackageName +#undef TclGetLoadedPackages #define TclStaticPackage Tcl_StaticPackage #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString @@ -287,8 +289,28 @@ mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) { # define Tcl_ChannelCloseProc 0 # define Tcl_Close 0 # define Tcl_MacOSXOpenBundleResources 0 +# define TclGuessPackageName 0 +# define TclGetLoadedPackages 0 #else +#define TclGuessPackageName guessPackageName +static int TclGuessPackageName( + TCL_UNUSED(const char *), + TCL_UNUSED(Tcl_DString *)) { + return 0; +} +#define TclGetLoadedPackages getLoadedPackages +static int TclGetLoadedPackages( + Tcl_Interp *interp, /* Interpreter in which to return information + * or error message. */ + const char *targetName) /* Name of target interpreter or NULL. If + * NULL, return info about all interps; + * otherwise, just return info about this + * interpreter. */ +{ + return TclGetLoadedPackagesEx(interp, targetName, NULL); +} + mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) { mp_digit d2; mp_err result = mp_div_d(a, 3, c, &d2); |