diff options
-rw-r--r-- | .github/workflows/linux-build.yml | 37 | ||||
-rw-r--r-- | .github/workflows/win-build.yml | 22 | ||||
-rw-r--r-- | .project | 15 | ||||
-rw-r--r-- | .travis.yml | 9 | ||||
-rw-r--r-- | README.md | 12 | ||||
-rw-r--r-- | doc/expr.n | 8 | ||||
-rw-r--r-- | doc/load.n | 5 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 53 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 5 | ||||
-rw-r--r-- | generic/tclLoad.c | 99 | ||||
-rw-r--r-- | generic/tclLoadNone.c | 30 | ||||
-rw-r--r-- | generic/tclStubInit.c | 22 | ||||
-rw-r--r-- | library/dde/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | library/registry/pkgIndex.tcl (renamed from library/reg/pkgIndex.tcl) | 2 | ||||
-rw-r--r-- | tests/compExpr.test | 36 | ||||
-rw-r--r-- | tests/expr-old.test | 2 | ||||
-rw-r--r-- | tests/expr.test | 61 | ||||
-rw-r--r-- | tests/parseExpr.test | 8 | ||||
-rw-r--r-- | tests/unload.test | 3 | ||||
-rw-r--r-- | tests/winDde.test | 4 | ||||
-rw-r--r-- | unix/tclLoadDl.c | 28 | ||||
-rw-r--r-- | unix/tclLoadDyld.c | 28 | ||||
-rw-r--r-- | unix/tclLoadNext.c | 30 | ||||
-rw-r--r-- | unix/tclLoadOSF.c | 30 | ||||
-rw-r--r-- | unix/tclLoadShl.c | 30 | ||||
-rw-r--r-- | win/Makefile.in | 24 | ||||
-rw-r--r-- | win/makefile.vc | 14 | ||||
-rw-r--r-- | win/tclAppInit.c | 4 | ||||
-rw-r--r-- | win/tclWinLoad.c | 28 |
29 files changed, 354 insertions, 297 deletions
diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml new file mode 100644 index 0000000..db46cfd --- /dev/null +++ b/.github/workflows/linux-build.yml @@ -0,0 +1,37 @@ +name: Linux Build and Test +on: [push] +jobs: + build: + runs-on: ubuntu-latest + steps: + - name: Checkout + uses: actions/checkout@v2 + - name: Configure + working-directory: unix + run: | + mkdir "${HOME}/install dir" + ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) + - name: Build + working-directory: unix + run: | + make all + - name: Build Test Harness + working-directory: unix + run: | + make tcltest + - name: Run Tests + working-directory: unix + run: | + make test + - name: Test-Drive Installation + working-directory: unix + run: | + make install + - name: Create Distribution Package + working-directory: unix + run: | + make dist + - name: Convert Documentation to HTML + working-directory: unix + run: | + make html-tcl diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml new file mode 100644 index 0000000..652b34a --- /dev/null +++ b/.github/workflows/win-build.yml @@ -0,0 +1,22 @@ +name: Windows Build and Test +on: [push] +jobs: + build: + runs-on: windows-latest + steps: + - name: Checkout + uses: actions/checkout@v2 + - name: Init MSVC + uses: ilammy/msvc-dev-cmd@v1 + - name: Build + working-directory: win + run: | + nmake -f makefile.vc all + - name: Build Test Harness + working-directory: win + run: | + nmake -f makefile.vc tcltest + - name: Run Tests + working-directory: win + run: | + nmake -f makefile.vc test @@ -5,7 +5,22 @@ <projects> </projects> <buildSpec> + <buildCommand> + <name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name> + <triggers>clean,full,incremental,</triggers> + <arguments> + </arguments> + </buildCommand> + <buildCommand> + <name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name> + <triggers>full,incremental,</triggers> + <arguments> + </arguments> + </buildCommand> </buildSpec> <natures> + <nature>org.eclipse.cdt.core.cnature</nature> + <nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature> + <nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature> </natures> </projectDescription> diff --git a/.travis.yml b/.travis.yml index ba88156..6438d66 100644 --- a/.travis.yml +++ b/.travis.yml @@ -259,6 +259,15 @@ jobs: script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test + - name: "Windows/MSVC/StaticPackage" + os: windows + compiler: cl + env: *vcenv + before_install: *vcpreinst + install: [] + script: + - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc all tcltest + - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC/Debug" os: windows compiler: cl @@ -5,7 +5,17 @@ This is the **Tcl 8.7a4** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). -[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-branch)](https://travis-ci.org/tcltk/tcl) +8.6.10 +[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-6-branch) +[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-6-branch) +<br> +8.7a4 +[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-branch) +[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-branch) +<br> +9.0a2 +[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Amain) +[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Amain) ## Contents 1. [Introduction](#intro) @@ -41,6 +41,12 @@ When an expression evaluates to an integer, the value is the decimal form of the integer, and when an expression evaluates to a floating-point number, the value is the form produced by the \fB%g\fR format specifier of Tcl's \fBformat\fR command. +.PP +.VS "TIP 582" +You can use \fB#\fR at any point in the expression (except inside double +quotes or braces) to start a comment. Comments last to the end of the line or +the end of the expression, whichever comes first. +.VE "TIP 582" .SS OPERANDS .PP An expression consists of a combination of operands, operators, parentheses and @@ -487,7 +493,9 @@ value of true: .PP .CS set isTrue [\fBexpr\fR { + # Does the environment variable exist, and... [info exists ::env(SOME_ENV_VAR)] && + # ...does it contain a proper true value? [string is true -strict $::env(SOME_ENV_VAR)] }] .CE @@ -89,9 +89,10 @@ Tcl tries to guess the name of the package. This may be done differently on different platforms. The default guess, which is used on most UNIX platforms, is to take the last element of \fIfileName\fR, strip off the first -three characters if they are \fBlib\fR, and use any following +three characters if they are \fBlib\fR, then strip off the next +three characters if they are \fBtcl\fR, and use any following alphabetic and underline characters as the module name. -For example, the command \fBload libxyz4.2.so\fR uses the module +For example, the command \fBload libtclxyz4.2.so\fR uses the module name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the module name \fBlast\fR. .PP diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index aabd764..41938e3 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; Tcl_UniChar ch = 0; 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..13fea29 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -302,60 +302,59 @@ 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; + if ((pkgGuess[0] == 't') && (pkgGuess[1] == 'c') + && (pkgGuess[2] == 'l')) { + pkgGuess += 3; + } + 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 +1024,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 +1043,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 36cb9b5..0204bca 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 @@ -261,8 +263,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); diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index a87db33..14f22a4 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,3 +1,3 @@ if {![package vsatisfies [package provide Tcl] 8.5-]} return if {[info sharedlibextension] != ".dll"} return -package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde] +package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll]] diff --git a/library/reg/pkgIndex.tcl b/library/registry/pkgIndex.tcl index 0413df6..8b35997 100644 --- a/library/reg/pkgIndex.tcl +++ b/library/registry/pkgIndex.tcl @@ -1,4 +1,4 @@ if {![package vsatisfies [package provide Tcl] 8.5-]} return if {[info sharedlibextension] != ".dll"} return package ifneeded registry 1.3.5 \ - [list load [file join $dir tclreg13.dll] registry] + [list load [file join $dir tclregistry13.dll]] diff --git a/tests/compExpr.test b/tests/compExpr.test index f6fe333..2222b8d 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -371,10 +371,46 @@ test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setu unset end i tmp rename getbytes {} } -result 0 + +proc extract {opcodes descriptor} { + set instructions [dict values [dict get $descriptor instructions]] + return [lmap i $instructions { + if {[lindex $i 0] in $opcodes} {string cat $i} else continue + }] +} + +test compExpr-8.1 {TIP 582: expression comments} -setup {} -body { + extract {loadStk add} [tcl::unsupported::getbytecode script {expr { + $abc + # + $def + + $ghi + }}] +} -result {loadStk loadStk add} +test compExpr-8.2 {TIP 582: expression comments} -setup {} -body { + extract {loadStk add} [tcl::unsupported::getbytecode script {expr { + $abc + # + $def + # + $ghi }}] +} -result loadStk +test compExpr-8.3 {TIP 582: expression comments} -setup {} -body { + extract {loadStk add} [tcl::unsupported::getbytecode script {expr { + $abc + # + $def\ + + $ghi + }}] +} -result loadStk +test compExpr-8.4 {TIP 582: expression comments} -setup {} -body { + extract {loadStk add} [tcl::unsupported::getbytecode script {expr { + $abc + # + $def\\ + + $ghi + }}] +} -result {loadStk loadStk add} # cleanup catch {unset a} catch {unset b} +catch {rename extract ""} ::tcltest::cleanupTests return diff --git a/tests/expr-old.test b/tests/expr-old.test index ab33e06..1a4278f 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -524,7 +524,7 @@ test expr-old-26.10b {error conditions} ieeeFloatingPoint { list [catch {expr 2.0/0.0} msg] $msg } {0 Inf} test expr-old-26.11 {error conditions} -body { - expr 2# + expr 2` } -returnCodes error -match glob -result * test expr-old-26.12 {error conditions} -body { expr a.b diff --git a/tests/expr.test b/tests/expr.test index c185580..9752c53 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -7384,6 +7384,67 @@ foreach v1 $values r1 $results { } } unset -nocomplain values results ctr + +test expr-62.1 {TIP 582: comments} -body { + expr {1 # + 2} +} -result 1 +test expr-62.2 {TIP 582: comments} -body { + expr "1 #\n+ 2" +} -result 3 +test expr-62.3 {TIP 582: comments} -setup { + set ctr 0 +} -body { + expr { + # This is a demonstration of a comment + 1 + 2 + 3 + # and another comment + + 4 + 5 + # + [incr ctr] + + [incr ctr] + } +} -result 16 +# Buggy because line breaks aren't tracked inside expressions at all +test expr-62.4 {TIP 582: comments don't hide line breaks} -setup { + proc getline {} { + dict get [info frame -1] line + } + set base [getline] +} -constraints knownBug -body { + expr { + 0 + # a comment + + [getline] - $base + } +} -cleanup { + rename getline "" +} -result 5 +test expr-62.5 {TIP 582: comments don't splice tokens} { + set a False + expr {$a#don't splice +ne#don't splice +false} +} 1 +test expr-62.6 {TIP 582: comments don't splice tokens} { + expr {0x2#don't splice +ne#don't splice +2} +} 1 +test expr-62.7 {TIP 582: comments can go inside function calls} { + expr {max(1,# comment + 2)} +} 2 +test expr-62.8 {TIP 582: comments can go inside function calls} { + expr {max(1# comment + ,2)} +} 2 +test expr-62.9 {TIP 582: comments can go inside function calls} { + expr {max(# comment + 1,2)} +} 2 +test expr-62.10 {TIP 582: comments can go inside function calls} { + expr {max# comment + (1,2)} +} 2 # cleanup unset -nocomplain a diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 3fbd14e..74ffd41 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -1075,6 +1075,14 @@ test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body { testexprparser in\u0433(0) -1 } -returnCodes error -match glob -result {missing operand*} +test parseExpr-23.1 {TIP 582: comments} -constraints testexprparser -body { + testexprparser "7 # * 8 " -1 +} -result {- {} 0 subexpr 7 1 text 7 0 {}} +test parseExpr-23.2 {TIP 582: comments} -constraints testexprparser -body { + testexprparser "7 #\n* 8 " -1 +} -result {- {} 0 subexpr {7 # +*} 5 operator # 0 subexpr 7 1 text 7 0 subexpr * 1 text * 0 {}} + # cleanup cleanupTests return diff --git a/tests/unload.test b/tests/unload.test index bab197b..3eb2bf7 100644 --- a/tests/unload.test +++ b/tests/unload.test @@ -38,9 +38,6 @@ testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] -# Certain tests require the 'teststaticpkg' command from tcltest -testConstraint teststaticpkg [llength [info commands teststaticpkg]] - # Certain tests need the 'testsimplefilsystem' in tcltest testConstraint testsimplefilesystem \ [llength [info commands testsimplefilesystem]] diff --git a/tests/winDde.test b/tests/winDde.test index d2fb8a0..421578b 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -20,7 +20,7 @@ if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands set ::ddever [package require dde 1.4.3] - set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} { + set ::ddelib [info loaded "" Dde]}]} { testConstraint dde 1 } } @@ -38,7 +38,7 @@ proc createChildProcess {ddeServerName args} { set f [open $::scriptName w+] puts $f [list set ddeServerName $ddeServerName] - puts $f [list load $::ddelib dde] + puts $f [list load $::ddelib Dde] puts $f { # DDE child server - # diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 07fd30b..2a09037 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -260,34 +260,6 @@ UnloadFile( } /* - *---------------------------------------------------------------------- - * - * 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( - TCL_UNUSED(const char *) /*fileName*/, - TCL_UNUSED(Tcl_DString *)) -{ - return 0; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index ee13350..de738e9 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -468,34 +468,6 @@ UnloadFile( /* *---------------------------------------------------------------------- * - * 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( - TCL_UNUSED(const char *) /*fileName*/, - TCL_UNUSED(Tcl_DString *) /*bufPtr*/) -{ - return 0; -} - -/* - *---------------------------------------------------------------------- - * * TclpLoadMemoryGetBuffer -- * * Allocate a buffer that can be used with TclpLoadMemory() below. diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index 8c62784..3f59998 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -179,36 +179,6 @@ UnloadFile( } /* - *---------------------------------------------------------------------- - * - * 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; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index bbcaa66..b8423dd 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -197,36 +197,6 @@ UnloadFile( } /* - *---------------------------------------------------------------------- - * - * TclGuessPackageName -- - * - * If the "load" command is invoked without providing a package name, - * this function 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; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index a92ddf5..876896a 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -186,36 +186,6 @@ UnloadFile( } /* - *---------------------------------------------------------------------- - * - * 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; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/Makefile.in b/win/Makefile.in index 7f0a9c6..fe3dfa1 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -150,15 +150,15 @@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX} -REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} -REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${DLLSUFFIX}${LIBSUFFIX} +REG_DLL_FILE = tclregistry$(REGVER)${DLLSUFFIX} +REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ - package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] dde];\ - package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] registry] -TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\ + package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}]];\ + package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}]] +TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}]];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll TOMMATH_DLL_FILE = libtommath.dll @@ -531,12 +531,12 @@ ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE} done) && \ $(LN) ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl && \ $(LN) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde/ && \ - $(LN) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg/ \ + $(LN) ${REG_DLL_FILE} ${TCL_VFS_PATH}/registry/ \ ) || ( \ $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \ $(COPY) -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \ $(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde; \ - $(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg; \ + $(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/registry; \ ) (zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}') 2>/dev/null || \ (echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")`; \ @@ -791,7 +791,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in dde${DDEDOTVER} reg${REGDOTVER}; \ + @for i in dde${DDEDOTVER} registry${REGDOTVER}; \ do \ if [ ! -d "$(LIB_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ @@ -825,13 +825,13 @@ install-binaries: binaries fi @if [ -f $(REG_DLL_FILE) ]; then \ echo Installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ - $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ + $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ + $(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \ + "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo Installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ + $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ fi install-libraries-zipfs-shared: libraries diff --git a/win/makefile.vc b/win/makefile.vc index a28d6bf..d3c294f 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -67,7 +67,7 @@ # static = Builds a static library of the core instead of a
# dll. The shell will be static (and large), as well.
# staticpkg = Affects the static option only to switch
-# tclshXX.exe to have the dde and reg extension linked
+# tclshXX.exe to have the dde and registry extension linked
# inside it.
# symbols = Adds symbols for step debugging.
# thrdalloc = Use the thread allocator (shared global free pool).
@@ -174,7 +174,7 @@ VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
!endif
!if [echo PKG_REG_VER =\>> versions.vc] \
- && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
+ && [nmakehlp -V ..\library\registry\pkgIndex.tcl "registry " >> versions.vc]
!endif
!include versions.vc
@@ -469,8 +469,8 @@ test: test-core test-pkgs test-core: setup $(TCLTEST) dlls
set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- package ifneeded dde 1.4.3 [list load "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" registry]
+ package ifneeded dde 1.4.3 [list load "$(TCLDDELIB:\=/)"]
+ package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)"]
<<
runtest: setup $(TCLTEST) dlls
@@ -981,9 +981,9 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
!endif
!else
- @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
- @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
- "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
+ @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\registry$(REGDOTVERSION)\"
+ @$(CPY) "$(ROOT)\library\registry\pkgIndex.tcl" \
+ "$(LIB_INSTALL_DIR)\registry$(REGDOTVERSION)\"
!endif
@echo Installing encodings
@$(CPY) "$(ROOT)\library\encoding\*.enc" \
diff --git a/win/tclAppInit.c b/win/tclAppInit.c index de5f788..3ab9fc8 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -168,12 +168,12 @@ Tcl_AppInit( if (Registry_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); + Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL); if (Dde_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); + Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit); #endif #ifdef TCL_TEST diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 1a74618..caaca42 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -262,34 +262,6 @@ UnloadFile( /* *---------------------------------------------------------------------- * - * TclGuessPackageName -- - * - * If the "load" command is invoked without providing a package name, - * this function 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( - TCL_UNUSED(const char *), - TCL_UNUSED(Tcl_DString *)) -{ - return 0; -} - -/* - *---------------------------------------------------------------------- - * * TclpTempFileNameForLibrary -- * * Constructs a temporary file name for loading a shared object (DLL). |