summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.github/workflows/linux-build.yml37
-rw-r--r--.github/workflows/win-build.yml22
-rw-r--r--.project15
-rw-r--r--.travis.yml9
-rw-r--r--README.md12
-rw-r--r--doc/expr.n8
-rw-r--r--generic/tclCompExpr.c53
-rw-r--r--generic/tclIntDecls.h5
-rw-r--r--generic/tclLoad.c95
-rw-r--r--generic/tclLoadNone.c30
-rw-r--r--generic/tclStubInit.c22
-rw-r--r--library/dde/pkgIndex.tcl2
-rw-r--r--library/reg/pkgIndex.tcl2
-rw-r--r--tests/compExpr.test36
-rw-r--r--tests/expr-old.test2
-rw-r--r--tests/expr.test61
-rw-r--r--tests/parseExpr.test8
-rw-r--r--tests/unload.test3
-rw-r--r--tests/winDde.test4
-rw-r--r--unix/tclLoadDl.c28
-rw-r--r--unix/tclLoadDyld.c28
-rw-r--r--unix/tclLoadNext.c30
-rw-r--r--unix/tclLoadOSF.c30
-rw-r--r--unix/tclLoadShl.c30
-rw-r--r--win/Makefile.in6
-rw-r--r--win/tclAppInit.c4
-rw-r--r--win/tclWinLoad.c28
27 files changed, 331 insertions, 279 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
diff --git a/.project b/.project
index eddd834..27fef70 100644
--- a/.project
+++ b/.project
@@ -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
diff --git a/README.md b/README.md
index 242b3b1..56db098 100644
--- a/README.md
+++ b/README.md
@@ -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)
diff --git a/doc/expr.n b/doc/expr.n
index 69f6399..2c2742c 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -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
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);
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index a87db33..e78d8f3 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] Dde]
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index 0413df6..ae5ded6 100644
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/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 tclreg13.dll] Registry]
diff --git a/tests/compExpr.test b/tests/compExpr.test
index 35d7588..4ef155b 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 914530e..327faa2 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 5e00841..da5a23d 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 8b5e429..735dace 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 815ff31..32767fa 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 fac21a8..ccdf00b 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -156,9 +156,9 @@ 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 Tcltest ${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}] Dde];\
+ package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] Registry]
+TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}]];\
$(TEST_LOAD_PRMS)
ZLIB_DLL_FILE = zlib1.dll
TOMMATH_DLL_FILE = libtommath.dll
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).
generated by cgit v0.12 at 2025-03-25 23:59:58 (GMT)