From d59315b818150c8cb704ebd55ca0abf30c524788 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Jul 2014 12:26:21 +0000 Subject: Bump to 8.5.16 for release. --- README | 2 +- generic/tcl.h | 4 ++-- library/init.tcl | 2 +- tools/tcl.wse.in | 2 +- unix/configure | 4 ++-- unix/configure.in | 2 +- unix/tcl.spec | 2 +- win/configure | 2 +- win/configure.in | 2 +- 9 files changed, 11 insertions(+), 11 deletions(-) diff --git a/README b/README index 2ad171f..256174f 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.5.15 source distribution. + This is the Tcl 8.5.16 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tcl from the URL above. diff --git a/generic/tcl.h b/generic/tcl.h index 5300bba..af1af58 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -58,10 +58,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 5 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 15 +#define TCL_RELEASE_SERIAL 16 #define TCL_VERSION "8.5" -#define TCL_PATCH_LEVEL "8.5.15" +#define TCL_PATCH_LEVEL "8.5.16" /* * The following definitions set up the proper options for Windows compilers. diff --git a/library/init.tcl b/library/init.tcl index 38c6bb3..61a80a5 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -16,7 +16,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.5.15 +package require -exact Tcl 8.5.16 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in index e22b74a..e1810ef 100644 --- a/tools/tcl.wse.in +++ b/tools/tcl.wse.in @@ -12,7 +12,7 @@ item: Global Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 - Disk Label=tcl8.5.15 + Disk Label=tcl8.5.16 Disk Filename=setup Patch Flags=0000000000000001 Patch Threshold=85 diff --git a/unix/configure b/unix/configure index d268647..e4ff106 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".15" +TCL_PATCH_LEVEL=".16" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -18915,7 +18915,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD} - ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" + ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure diff --git a/unix/configure.in b/unix/configure.in index 318bcf8..3228353 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".15" +TCL_PATCH_LEVEL=".16" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index b61f4bf..bdc6e27 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.5.15 +Version: 8.5.16 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index cec352b..8e33eb3 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".15" +TCL_PATCH_LEVEL=".16" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 diff --git a/win/configure.in b/win/configure.in index cde3ab4..aa42036 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".15" +TCL_PATCH_LEVEL=".16" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 -- cgit v0.12 From 40da2e77b5aa89aae9a3324e40f45f8061208f08 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 23 Jul 2014 13:10:34 +0000 Subject: Revert the EOLFIX changes of checkin [a803608ed5] (2013-10-28). They do not work on the one machine where they must -- the release managers! Appears that the NATIVE_TCLSH support isn't found on the 8.5 branch, so we shouldn't expect to use it. --- unix/Makefile.in | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 1738570..d3b810c 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1660,7 +1660,6 @@ $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure cd $(MAC_OSX_DIR); autoheader; touch $@ -EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs rm -rf $(DISTDIR) mkdir -p $(DISTDIR)/unix @@ -1720,17 +1719,17 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win - @$(EOLFIX) -crlf $(DISTDIR)/win/*.bat + @$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win - @$(EOLFIX) -crlf $(DISTDIR)/win/makefile.bc $(DISTDIR)/win/makefile.vc + @$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.bc $(DISTDIR)/win/makefile.vc cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win - @$(EOLFIX) -crlf $(DISTDIR)/win/rules.vc + @$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win - @$(EOLFIX) -crlf $(DISTDIR)/win/coffbase.txt + @$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/coffbase.txt cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win - @$(EOLFIX) -crlf $(DISTDIR)/win/tcl.hpj.in + @$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.hpj.in cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win - @$(EOLFIX) -crlf $(DISTDIR)/win/tcl.ds* + @$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.ds* cp -p $(TOP_DIR)/win/README $(DISTDIR)/win cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win @mkdir $(DISTDIR)/macosx @@ -1756,7 +1755,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M $(TOOL_DIR)/tcl.wse.in $(TOOL_DIR)/*.bmp \ $(TOOL_DIR)/tcl.hpj.in \ $(DISTDIR)/tools - @$(EOLFIX)-crlf $(DISTDIR)/tools/tcl.hpj.in \ + @$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in \ $(DISTDIR)/tools/tcl.wse.in @mkdir $(DISTDIR)/libtommath cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \ -- cgit v0.12 From 199f805233d9af1ccfd843748bffd339b275bbab Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sat, 2 Aug 2014 13:04:16 +0000 Subject: TIP 429 Implementation: [string cat] --- doc/string.n | 8 ++++++ generic/tclCmdMZ.c | 71 +++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclCompCmdsSZ.c | 33 +++++++++++++++++++++++ generic/tclInt.h | 3 +++ tests/string.test | 34 +++++++++++++++++++---- tests/stringComp.test | 38 ++++++++++++++++++++++++-- 6 files changed, 180 insertions(+), 7 deletions(-) diff --git a/doc/string.n b/doc/string.n index 72a69ff..9108e7c 100644 --- a/doc/string.n +++ b/doc/string.n @@ -19,6 +19,14 @@ string \- Manipulate strings Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: .TP +\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR? +. +Concatenate the given strings just like direct juxtaposition +would. This primitive is occasionally handier than juxtaposition when +mixed quoting is wanted, or when the aim is to return the result of a +concatenation without resorting to \fB[return -level 0]\fR. If no arg +is present, an empty string is returned. +.TP \fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . Perform a character-by-character comparison of strings \fIstring1\fR diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 0f7f20a..ea5d7a4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2838,6 +2838,76 @@ StringCmpCmd( /* *---------------------------------------------------------------------- * + * StringCatCmd -- + * + * This procedure is invoked to process the "string cat" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +StringCatCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int tot, i, length; + char *bytes, *p; + Tcl_Obj *objResultPtr; + + /* + * NOTE: this implementation aims for simplicity, not speed, because all + * speed-critical uses of [string cat] will involve the compiled variant + * anyway. Thus we avoid code duplication (from TEBC/INST_CONCAT1) without + * sacrificing perf. + */ + + if (objc < 2) { + /* + * If there are no args, the result is an empty object. + * Just leave the preset empty interp result. + */ + return TCL_OK; + } + tot = 0; + for(i = 1;i < objc;i++) { + bytes = TclGetStringFromObj(objv[i], &length); + if (bytes != NULL) { + tot += length; + } + } + if (tot < 0) { + /* TODO: convert panic to error ? */ + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + p = ckalloc(tot + 1); + TclNewObj(objResultPtr); + objResultPtr->bytes = p; + objResultPtr->length = tot; + for (i = 1;i < objc;i++) { + bytes = TclGetStringFromObj(objv[i], &length); + if (bytes != NULL) { + memcpy(p, bytes, (size_t) length); + p += length; + } + } + *p = '\0'; + Tcl_SetObjResult(interp,objResultPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * StringBytesCmd -- * * This procedure is invoked to process the "string bytelength" Tcl @@ -3330,6 +3400,7 @@ TclInitStringCmd( { static const EnsembleImplMap stringImplMap[] = { {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0}, diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index e6ec0a6..8ade6a5 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -269,6 +269,39 @@ TclCompileSetCmd( */ int +TclCompileStringCatCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + int numWords = parsePtr->numWords; + Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); + DefineLineInformation; /* TIP #280 */ + + if (numWords>=2) { + int i; + + for (i = 1; i < numWords; i++) { + CompileWord(envPtr, wordTokenPtr, interp, i); + wordTokenPtr = TokenAfter(wordTokenPtr); + } + while (numWords > 256) { + TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); + numWords -= 254; /* concat pushes 1 obj, the result */ + } + if (numWords > 2) { + TclEmitInstInt1(INST_STR_CONCAT1, numWords - 1, envPtr); + } + } else { + PushStringLiteral(envPtr, ""); + } + return TCL_OK; +} + +int TclCompileStringCmpCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command diff --git a/generic/tclInt.h b/generic/tclInt.h index 1bb2103..6bf1ef9 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3646,6 +3646,9 @@ MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringCatCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); diff --git a/tests/string.test b/tests/string.test index a8a83d9..54d02e8 100644 --- a/tests/string.test +++ b/tests/string.test @@ -30,7 +30,7 @@ testConstraint memory [llength [info commands memory]] test string-1.1 {error conditions} { list [catch {string gorp a b} msg] $msg -} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-1.2 {error conditions} { list [catch {string} msg] $msg } {1 {wrong # args: should be "string subcommand ?arg ...?"}} @@ -54,7 +54,7 @@ test string-2.6 {string compare} { string compare abcde abdef } -1 test string-2.7 {string compare, shortest method name} { - string c abcde ABCDE + string co abcde ABCDE } 1 test string-2.8 {string compare} { string compare abcde abcde @@ -81,7 +81,7 @@ test string-2.13 {string compare -nocase} { string compare -nocase abcde abdef } -1 test string-2.14 {string compare -nocase} { - string c -nocase abcde ABCDE + string compare -nocase abcde ABCDE } 0 test string-2.15 {string compare -nocase} { string compare -nocase abcde abcde @@ -1513,7 +1513,7 @@ test string-20.1 {string trimright errors} { } {1 {wrong # args: should be "string trimright string ?chars?"}} test string-20.2 {string trimright errors} { list [catch {string trimg a} msg] $msg -} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-20.3 {string trimright} { string trimright " XYZ " } { XYZ} @@ -1572,7 +1572,7 @@ test string-21.14 {string wordend, unicode} { test string-22.1 {string wordstart} { list [catch {string word a} msg] $msg -} {1 {unknown or ambiguous subcommand "word": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-22.2 {string wordstart} { list [catch {string wordstart a} msg] $msg } {1 {wrong # args: should be "string wordstart string index"}} @@ -1969,6 +1969,30 @@ test string-28.13 {tcl::prefix longest} { tcl::prefix longest {ax\x90 bep ax\x91} a } ax +test string-29.1 {string cat, no arg} { + string cat +} "" +test string-29.2 {string cat, single arg} { + set x [pid] + string compare $x [string cat $x] +} 0 +test string-29.3 {string cat, two args} { + set x [pid] + string compare $x$x [string cat $x $x] +} 0 +test string-29.4 {string cat, many args} { + set x [pid] + set n 260 + set xx [string repeat $x $n] + set vv [string repeat {$x} $n] + set vvs [string repeat {$x } $n] + set r1 [string compare $xx [subst $vv]] + set r2 [string compare $xx [eval "string cat $vvs"]] + list $r1 $r2 +} {0 0} + + + # cleanup rename MemStress {} catch {rename foo {}} diff --git a/tests/stringComp.test b/tests/stringComp.test index 165ef20..083399b 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -46,7 +46,7 @@ if {[testConstraint memory]} { test stringComp-1.1 {error conditions} { proc foo {} {string gorp a b} list [catch {foo} msg] $msg -} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test stringComp-1.2 {error conditions} { proc foo {} {string} list [catch {foo} msg] $msg @@ -210,7 +210,7 @@ foreach {tname tbody tresult tcode} { # need a few extra tests short abbr cmd test stringComp-3.1 {string compare, shortest method name} { - proc foo {} {string c abcde ABCDE} + proc foo {} {string co abcde ABCDE} foo } 1 test stringComp-3.2 {string equal, shortest method name} { @@ -735,6 +735,40 @@ test stringComp-14.2 {Bug 82e7f67325} memory { ## string word* ## not yet bc + +## string cat +test stringComp-29.1 {string cat, no arg} { + proc foo {} {string cat} + foo +} "" +test stringComp-29.2 {string cat, single arg} { + proc foo {} { + set x [pid] + string compare $x [string cat $x] + } + foo +} 0 +test stringComp-29.3 {string cat, two args} { + proc foo {} { + set x [pid] + string compare $x$x [string cat $x $x] + } + foo +} 0 +test stringComp-29.4 {string cat, many args} { + proc foo {} { + set x [pid] + set n 260 + set xx [string repeat $x $n] + set vv [string repeat {$x} $n] + set vvs [string repeat {$x } $n] + set r1 [string compare $xx [subst $vv]] + set r2 [string compare $xx [eval "string cat $vvs"]] + list $r1 $r2 + } + foo +} {0 0} + # cleanup catch {rename foo {}} -- cgit v0.12 From 50e84817bf26eed388c0fb3df70cfb4d00e9eab5 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sat, 2 Aug 2014 15:26:46 +0000 Subject: Don't use [pid] in tests, stick to constant literals. --- doc/string.n | 2 ++ tests/string.test | 6 +++--- tests/stringComp.test | 6 +++--- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/doc/string.n b/doc/string.n index 9108e7c..450a97b 100644 --- a/doc/string.n +++ b/doc/string.n @@ -19,6 +19,7 @@ string \- Manipulate strings Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: .TP +.VS 8.6.2 \fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR? . Concatenate the given strings just like direct juxtaposition @@ -26,6 +27,7 @@ would. This primitive is occasionally handier than juxtaposition when mixed quoting is wanted, or when the aim is to return the result of a concatenation without resorting to \fB[return -level 0]\fR. If no arg is present, an empty string is returned. +.VE .TP \fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . diff --git a/tests/string.test b/tests/string.test index 54d02e8..3611753 100644 --- a/tests/string.test +++ b/tests/string.test @@ -1973,15 +1973,15 @@ test string-29.1 {string cat, no arg} { string cat } "" test string-29.2 {string cat, single arg} { - set x [pid] + set x FOO string compare $x [string cat $x] } 0 test string-29.3 {string cat, two args} { - set x [pid] + set x FOO string compare $x$x [string cat $x $x] } 0 test string-29.4 {string cat, many args} { - set x [pid] + set x FOO set n 260 set xx [string repeat $x $n] set vv [string repeat {$x} $n] diff --git a/tests/stringComp.test b/tests/stringComp.test index 083399b..f9f6bda 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -743,21 +743,21 @@ test stringComp-29.1 {string cat, no arg} { } "" test stringComp-29.2 {string cat, single arg} { proc foo {} { - set x [pid] + set x FOO string compare $x [string cat $x] } foo } 0 test stringComp-29.3 {string cat, two args} { proc foo {} { - set x [pid] + set x FOO string compare $x$x [string cat $x $x] } foo } 0 test stringComp-29.4 {string cat, many args} { proc foo {} { - set x [pid] + set x FOO set n 260 set xx [string repeat $x $n] set vv [string repeat {$x} $n] -- cgit v0.12 From 483ef76a4114d3d190ea82c0cdbf88fdb1b9ee9e Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 3 Aug 2014 22:43:42 +0000 Subject: Tidy up the docs --- doc/string.n | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/doc/string.n b/doc/string.n index 450a97b..33780ff 100644 --- a/doc/string.n +++ b/doc/string.n @@ -19,14 +19,19 @@ string \- Manipulate strings Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: .TP -.VS 8.6.2 \fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR? -. -Concatenate the given strings just like direct juxtaposition -would. This primitive is occasionally handier than juxtaposition when -mixed quoting is wanted, or when the aim is to return the result of a -concatenation without resorting to \fB[return -level 0]\fR. If no arg -is present, an empty string is returned. +.VS 8.6.2 +Concatenate the given \fIstring\fRs just like placing them directly +next to each other and return the resulting compound string. If no +\fIstring\fRs are present, the result is an empty string. +.RS +.PP +This primitive is occasionally handier than juxtaposition of strings +when mixed quoting is wanted, or when the aim is to return the result +of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR, +and is more efficient than building a list of arguments and using +\fBjoin\fR with an empty join string. +.RE .VE .TP \fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR -- cgit v0.12 From 93a502d2ff6f6a849b8307bd531f5b55dea69e24 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Tue, 5 Aug 2014 09:55:54 +0000 Subject: More optimized non-BC [string cat] using Tcl_AppendObjToObj() - thx Donal --- generic/tclCmdMZ.c | 45 ++++++++++++++------------------------------- 1 file changed, 14 insertions(+), 31 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ea5d7a4..841002f 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2859,17 +2859,9 @@ StringCatCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tot, i, length; - char *bytes, *p; + int i; Tcl_Obj *objResultPtr; - /* - * NOTE: this implementation aims for simplicity, not speed, because all - * speed-critical uses of [string cat] will involve the compiled variant - * anyway. Thus we avoid code duplication (from TEBC/INST_CONCAT1) without - * sacrificing perf. - */ - if (objc < 2) { /* * If there are no args, the result is an empty object. @@ -2877,30 +2869,21 @@ StringCatCmd( */ return TCL_OK; } - tot = 0; - for(i = 1;i < objc;i++) { - bytes = TclGetStringFromObj(objv[i], &length); - if (bytes != NULL) { - tot += length; - } + if (objc == 2) { + /* + * Other trivial case, single arg, just return it. + */ + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; } - if (tot < 0) { - /* TODO: convert panic to error ? */ - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - p = ckalloc(tot + 1); - TclNewObj(objResultPtr); - objResultPtr->bytes = p; - objResultPtr->length = tot; - for (i = 1;i < objc;i++) { - bytes = TclGetStringFromObj(objv[i], &length); - if (bytes != NULL) { - memcpy(p, bytes, (size_t) length); - p += length; - } + objResultPtr = objv[1]; + if (Tcl_IsShared(objResultPtr)) { + objResultPtr = Tcl_DuplicateObj(objResultPtr); + } + for(i = 2;i < objc;i++) { + Tcl_AppendObjToObj(objResultPtr, objv[i]); } - *p = '\0'; - Tcl_SetObjResult(interp,objResultPtr); + Tcl_SetObjResult(interp, objResultPtr); return TCL_OK; } -- cgit v0.12 From 60a802acb616e77ccf3cab5328dccaea820f3e66 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Tue, 5 Aug 2014 10:34:10 +0000 Subject: Add constant folding to [string cat]. Mixed-quote idiom is now compiled to a single push. --- generic/tclCompCmdsSZ.c | 62 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 46 insertions(+), 16 deletions(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 8ade6a5..bd8b463 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -277,27 +277,57 @@ TclCompileStringCatCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - int numWords = parsePtr->numWords; - Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); + int i,numWords = parsePtr->numWords; + Tcl_Token *wordTokenPtr; + Tcl_Obj *obj, *folded; DefineLineInformation; /* TIP #280 */ - if (numWords>=2) { - int i; + /* Trivial case, no arg */ - for (i = 1; i < numWords; i++) { - CompileWord(envPtr, wordTokenPtr, interp, i); - wordTokenPtr = TokenAfter(wordTokenPtr); - } - while (numWords > 256) { - TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); - numWords -= 254; /* concat pushes 1 obj, the result */ - } - if (numWords > 2) { - TclEmitInstInt1(INST_STR_CONCAT1, numWords - 1, envPtr); - } - } else { + if (numWords<2) { PushStringLiteral(envPtr, ""); + return TCL_OK; } + + /* Detection of foldable constants. Often used for mixed quoting. */ + + folded = Tcl_NewObj(); + wordTokenPtr = TokenAfter(parsePtr->tokenPtr); + for (i = 1; i < numWords; i++) { + obj = Tcl_NewObj(); + if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) { + Tcl_AppendObjToObj(folded, obj); + } else { + Tcl_DecrRefCount(obj); + Tcl_DecrRefCount(folded); + folded = NULL; + break; + } + wordTokenPtr = TokenAfter(wordTokenPtr); + } + if (folded) { + int len; + const char *bytes = Tcl_GetStringFromObj(folded, &len); + + PushLiteral(envPtr, bytes, len); + return TCL_OK; + } + + /* General case: just issue CONCAT1's (by chunks of 255 if needed) */ + + wordTokenPtr = TokenAfter(parsePtr->tokenPtr); + for (i = 1; i < numWords; i++) { + CompileWord(envPtr, wordTokenPtr, interp, i); + wordTokenPtr = TokenAfter(wordTokenPtr); + } + while (numWords > 256) { + TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); + numWords -= 254; /* concat pushes 1 obj, the result */ + } + if (numWords > 2) { + TclEmitInstInt1(INST_STR_CONCAT1, numWords - 1, envPtr); + } + return TCL_OK; } -- cgit v0.12 From 201e2d1d6adb55742fd72f75a35c18bba901a0eb Mon Sep 17 00:00:00 2001 From: ferrieux Date: Tue, 5 Aug 2014 11:29:16 +0000 Subject: Better organize [string cat] by chunks of 255 args. --- generic/tclCompCmdsSZ.c | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index bd8b463..87b1ebb 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -277,7 +277,7 @@ TclCompileStringCatCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - int i,numWords = parsePtr->numWords; + int i, numWords = parsePtr->numWords, numArgs; Tcl_Token *wordTokenPtr; Tcl_Obj *obj, *folded; DefineLineInformation; /* TIP #280 */ @@ -315,17 +315,19 @@ TclCompileStringCatCmd( /* General case: just issue CONCAT1's (by chunks of 255 if needed) */ + numArgs = 0; wordTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { CompileWord(envPtr, wordTokenPtr, interp, i); + numArgs ++; + if (numArgs == 255) { + TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); + numArgs = 1; /* concat pushes 1 obj, the result */ + } wordTokenPtr = TokenAfter(wordTokenPtr); } - while (numWords > 256) { - TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); - numWords -= 254; /* concat pushes 1 obj, the result */ - } - if (numWords > 2) { - TclEmitInstInt1(INST_STR_CONCAT1, numWords - 1, envPtr); + if (numArgs > 1) { + TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr); } return TCL_OK; -- cgit v0.12 From 504a1200f71158b91d5d939b25c21c5110985963 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Tue, 5 Aug 2014 18:20:48 +0000 Subject: More aggressive constant folding in [string cat]. Thanks AndreasK for kicking. --- generic/tclCompCmdsSZ.c | 47 +++++++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 87b1ebb..fb26430 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -289,19 +289,38 @@ TclCompileStringCatCmd( return TCL_OK; } - /* Detection of foldable constants. Often used for mixed quoting. */ + /* General case: issue CONCAT1's (by chunks of 255 if needed), folding + contiguous constants along the way */ - folded = Tcl_NewObj(); + numArgs = 0; + folded = NULL; wordTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { obj = Tcl_NewObj(); if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) { - Tcl_AppendObjToObj(folded, obj); + if (folded) { + Tcl_AppendObjToObj(folded, obj); + Tcl_DecrRefCount(obj); + } else { + folded = obj; + } } else { Tcl_DecrRefCount(obj); - Tcl_DecrRefCount(folded); - folded = NULL; - break; + if (folded) { + int len; + const char *bytes = Tcl_GetStringFromObj(folded, &len); + + PushLiteral(envPtr, bytes, len); + Tcl_DecrRefCount(folded); + folded = NULL; + numArgs ++; + } + CompileWord(envPtr, wordTokenPtr, interp, i); + numArgs ++; + if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */ + TclEmitInstInt1(INST_STR_CONCAT1, 254, envPtr); + numArgs -= 253; /* concat pushes 1 obj, the result */ + } } wordTokenPtr = TokenAfter(wordTokenPtr); } @@ -310,21 +329,9 @@ TclCompileStringCatCmd( const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); - return TCL_OK; - } - - /* General case: just issue CONCAT1's (by chunks of 255 if needed) */ - - numArgs = 0; - wordTokenPtr = TokenAfter(parsePtr->tokenPtr); - for (i = 1; i < numWords; i++) { - CompileWord(envPtr, wordTokenPtr, interp, i); + Tcl_DecrRefCount(folded); + folded = NULL; numArgs ++; - if (numArgs == 255) { - TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); - numArgs = 1; /* concat pushes 1 obj, the result */ - } - wordTokenPtr = TokenAfter(wordTokenPtr); } if (numArgs > 1) { TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr); -- cgit v0.12 From f56a79a4ead94c1a0bb1338f91eff356d141124c Mon Sep 17 00:00:00 2001 From: ferrieux Date: Tue, 5 Aug 2014 22:10:58 +0000 Subject: Fix comment inaccuracy. --- generic/tclCompCmdsSZ.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index fb26430..f2e5dd2 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -289,7 +289,7 @@ TclCompileStringCatCmd( return TCL_OK; } - /* General case: issue CONCAT1's (by chunks of 255 if needed), folding + /* General case: issue CONCAT1's (by chunks of 254 if needed), folding contiguous constants along the way */ numArgs = 0; -- cgit v0.12 From 1e779b8343a56ffc0f4f80c8d2016e5fd8371eaf Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Aug 2014 21:41:29 +0000 Subject: Update changes file --- changes | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) diff --git a/changes b/changes index 5d6ef97..78765f2 100644 --- a/changes +++ b/changes @@ -7791,3 +7791,106 @@ Many revisions to better support a Cygwin environment (nijtmans) 2013-09-13 (bug fix)[bdd91c] crash in exec stack mem management (azazel) --- Released 8.5.15, September 16, 2013 --- http://core.tcl.tk/tcl/ for details + +2013-09-19 (bug fix)[3487626] [dict] compile segfaults (porter) + +2013-09-19 (bug fix) [info frame] line OBOEs in bytecode (porter) + +2013-09-25 (bug fix)[d614d63] namespace matching *:: deletion fail (fellows) + +2013-10-05 tzdata updated to Olson's tzdata2013g (kenny) + +2013-10-22 (bug fix)[3556215] [scan %E%G%X] support (fellows) + +2013-10-25 (bug fix)[3eb2ec1] upper case scheme names in url. (nijtmans) +=> http 2.7.13 + +2013-10-29 (bug fix)[414d103] HP-UX: restore [exec] in threaded Tcl (nijtmans) + +2013-11-04 (bug fix) C++ friendly stubs struct declarations (nijtmans) + +2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans) + +2013-11-20 (bug fix) Improved environment variable management (nijtmans) +=> tcltest 2.3.7 + +2013-11-21 (platforms) Support for Windows 8.1 (nijtmans) + +2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter) + +2014-02-24 (bug fix)[2413550] Win: avoid serial double open (oehlmann) + +2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans) + +2014-03-27 (bug fix) segfault iocmd-23.11 (porter) + +2014-04-02 (bug fix)[336441e] Win: async socket connect stall (oehlmann) + +2014-04-04 (bug fix)[581937a,97069ea] async socket connect fail (oehlmann) + +2014-04-10 (bug fix)[792641f] Win: no \ in normalized path (nijtmans) + +2014-04-15 (bug fix)[88aef05] segfault iocmd-21.20 (porter) + +2014-04-16 (update) Win: use Winsock 2.2 (nijtmans) + +2014-04-16 (bug fix)[d19a30d] segfault clock-67.[23] (sebres) + +2014-04-21 (bug fix) segfault iocmd-21.2[12] (porter) + +2014-04-22 (bug fix) segfault iogt-2.4 (porter) + +2014-04-23 (bug fix)[3493120] memleak in thread exit + +2014-04-30 (bug fix) segfault iocmd-21.2[34] (porter) + +2014-05-01 (bug fix)[0e92c40] bytearray optimization validity (nijtmans) + +2014-05-06 (bug fix) segfault iogt-2.5 (porter) + +2014-05-06 (memleaks) io-29.27 io-29.34 io-33.7 (porter) + +2014-05-07 (memleaks) io-53.5, cloned Tcl_ChannelTypes (porter) + +2014-05-08 (memleak) iocmd-21.22 (porter) + +2014-05-08 refactoring of core I/O functions (porter) + +2014-05-09 (bug fix) segfault iocmd-32.1 (porter) + +2014-05-15 (bug fix)[3118489] protect NUL in filenames (nijtmans) + +2014-05-16 (bug fix) Fix for failing tests *io-32.11* (porter) + +2014-05-20 (bug fix) Stop eof and blocked state leaking thru stacks (porter) + *** POTENTIAL INCOMPATIBILITY *** + +2014-05-22 (platforms) work around systems that fail when a shared library +is deleted after it is [load]ed (kupries) + +2014-05-31 (bug fix) chan events on pipes must be on proper ends (porter) + +2014-06-04 (bug fix) socket-2.12 (porter) + +2014-06-05 (bug fix) io-12.6 (kupries,porter) + +2014-06-16 (bug fix) socket-2.13 workaround broken select() (porter) + +2014-06-20 (bug fix)[b47b176] iortrans.tf-11.0 (porter) + +2014-06-22 (RFE)[2f9df4c] -cleanup scripts before -out compare (nijtmans) + +2014-07-04 (update) Update Unicode data to 7.0 (nijtmans) + *** POTENTIAL INCOMPATIBILITY *** + +2014-07-10 (bug fix)[7368d2] memleak Tcl_SetVar2(..,TCL_APPEND_VALUE) (porter) + *** POTENTIAL INCOMPATIBILITY *** + +2014-08-01 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime +of Tcl_Channel (porter) + *** POTENTIAL INCOMPATIBILITY *** + +2014-08-01 (update) "macosx*-i386-x86_64" "macosx-universal" no longer compatible (kupries) +=> platform 1.0.13 + +--- Released 8.5.16, August, 2014 --- http://core.tcl.tk/tcl/ for details -- cgit v0.12 From 5a6f33860c92df4d742266256ad5c9d0c9bd6302 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 14 Aug 2014 16:48:08 +0000 Subject: Reconcile changes file with 8.6.1. --- changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changes b/changes index 9970cbc..5c90fd5 100644 --- a/changes +++ b/changes @@ -7792,7 +7792,7 @@ Many revisions to better support a Cygwin environment (nijtmans) --- Released 8.5.15, September 16, 2013 --- http://core.tcl.tk/tcl/ for details -2013-09-19 (bug fix)[3487626] [dict] compile segfaults (porter) +2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter) 2013-09-19 (bug fix) [info frame] line OBOEs in bytecode (porter) -- cgit v0.12 From 78ccd5e19e769a8b4736728372c8c8b24f34e384 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 18 Aug 2014 13:28:58 +0000 Subject: Improved credit --- changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changes b/changes index 5c90fd5..0b56ec0 100644 --- a/changes +++ b/changes @@ -7816,7 +7816,7 @@ Many revisions to better support a Cygwin environment (nijtmans) 2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter) -2014-02-24 (bug fix)[2413550] Win: avoid serial double open (oehlmann) +2014-02-24 (bug fix)[2413550] Win: avoid serial double open (schroeter) 2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans) -- cgit v0.12 From 0cd901f4c8145e6b325a374e44ccb136804a1d19 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 25 Aug 2014 13:31:10 +0000 Subject: `make dist` allowed README-* fossil droppings to leak into the distribution. --- unix/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index f6e3b17..4fcdd14 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1680,7 +1680,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic - cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \ + cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) @mkdir $(DISTDIR)/library -- cgit v0.12