summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-11-25 09:38:04 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-11-25 09:38:04 (GMT)
commit90781d6874c5e6c4a1c2f50f933330a3a76ebbce (patch)
tree51fed05c893c751728742ac2ffb65f0c9a9538e5
parentfe050914128d2cb08469451d9bc1fa1904558060 (diff)
parenta3572d2400fc9b189ceb5f6f2c929486d136ab05 (diff)
downloadtcl-90781d6874c5e6c4a1c2f50f933330a3a76ebbce.zip
tcl-90781d6874c5e6c4a1c2f50f933330a3a76ebbce.tar.gz
tcl-90781d6874c5e6c4a1c2f50f933330a3a76ebbce.tar.bz2
Merge trunk, and fix two socket test-cases.
-rw-r--r--doc/OpenTcp.32
-rw-r--r--generic/tcl.h11
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCmdMZ.c2
-rw-r--r--generic/tclCompile.h2
-rw-r--r--generic/tclDisassemble.c4
-rw-r--r--generic/tclHash.c4
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclLoad.c2
-rw-r--r--generic/tclPipe.c2
-rw-r--r--generic/tclRegexp.c13
-rw-r--r--tests/set-old.test7
-rw-r--r--tests/socket.test2
13 files changed, 35 insertions, 20 deletions
diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3
index 040a8e2..a39f6f6 100644
--- a/doc/OpenTcp.3
+++ b/doc/OpenTcp.3
@@ -45,7 +45,7 @@ chosen.
.AP int async in
If nonzero, the client socket is connected asynchronously to the server.
.AP "unsigned int" flags in
-ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional
+ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional
informations about the socket being created.
.AP ClientData sock in
Platform-specific handle for client TCP socket.
diff --git a/generic/tcl.h b/generic/tcl.h
index 75a947a..7cdcbb6 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -831,19 +831,20 @@ typedef struct Tcl_Obj {
union { /* The internal representation: */
long longValue; /* - an long integer value. */
double doubleValue; /* - a double-precision floating value. */
- void *otherValuePtr; /* - another, type-specific value,
- not used internally any more. */
+ void *otherValuePtr; /* - another, type-specific value, not used
+ * internally any more. */
Tcl_WideInt wideValue; /* - a long long value. */
struct { /* - internal rep as two pointers.
- * the main use of which is a bignum's
+ * Many uses in Tcl, including a bignum's
* tightly packed fields, where the alloc,
* used and signum flags are packed into
- * ptr2 with everything else hung off ptr1. */
+ * ptr2 with everything else hung off
+ * ptr1. */
void *ptr1;
void *ptr2;
} twoPtrValue;
struct { /* - internal rep as a pointer and a long,
- not used internally any more. */
+ * not used internally any more. */
void *ptr;
unsigned long value;
} ptrAndLongRep;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8eebab1..c1dd52d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -588,7 +588,7 @@ Tcl_CreateInterp(void)
iPtr->cmdCount = 0;
TclInitLiteralTable(&iPtr->literalTable);
- iPtr->compileEpoch = 0;
+ iPtr->compileEpoch = 1;
iPtr->compiledProcPtr = NULL;
iPtr->resolverPtr = NULL;
iPtr->evalFlags = 0;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index e9a6933..023c671 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -323,7 +323,7 @@ Tcl_RegexpObjCmd(
if (match == 0) {
/*
- * We want to set the value of the intepreter result only when
+ * We want to set the value of the interpreter result only when
* this is the first time through the loop.
*/
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 89cdc59..5ef154e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -417,7 +417,7 @@ typedef struct ByteCode {
* procs are specific to an interpreter so the
* code emitted will depend on the
* interpreter. */
- int compileEpoch; /* Value of iPtr->compileEpoch when this
+ unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this
* ByteCode was compiled. Used to invalidate
* code when, e.g., commands with compile
* procs are redefined. */
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 88ff094..0d6da8e 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -272,8 +272,8 @@ DisassembleByteCodeObj(
sprintf(ptrBuf1, "%p", codePtr);
sprintf(ptrBuf2, "%p", iPtr);
Tcl_AppendPrintfToObj(bufferObj,
- "ByteCode 0x%s, refCt %" TCL_LL_MODIFIER "u, epoch %u, interp 0x%s (epoch %u)\n",
- ptrBuf1, (Tcl_WideInt)codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
+ "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
+ ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
diff --git a/generic/tclHash.c b/generic/tclHash.c
index ac9d40e..78ad514 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -924,7 +924,7 @@ HashStringKey(
*
* BogusFind --
*
- * This function is invoked when an Tcl_FindHashEntry is called on a
+ * This function is invoked when Tcl_FindHashEntry is called on a
* table that has been deleted.
*
* Results:
@@ -951,7 +951,7 @@ BogusFind(
*
* BogusCreate --
*
- * This function is invoked when an Tcl_CreateHashEntry is called on a
+ * This function is invoked when Tcl_CreateHashEntry is called on a
* table that has been deleted.
*
* Results:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3e55004..4257ea1 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1898,7 +1898,7 @@ typedef struct Interp {
* compiled by the interpreter. Indexed by the
* string representations of literals. Used to
* avoid creating duplicate objects. */
- int compileEpoch; /* Holds the current "compilation epoch" for
+ unsigned int compileEpoch; /* Holds the current "compilation epoch" for
* this interpreter. This is incremented to
* invalidate existing ByteCodes when, e.g., a
* command with a compile procedure is
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 7c70e03..be296b3 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -1015,7 +1015,7 @@ Tcl_StaticPackage(
* TclGetLoadedPackages --
*
* This function returns information about all of the files that are
- * loaded (either in a particular intepreter, or for all interpreters).
+ * loaded (either in a particular interpreter, or for all interpreters).
*
* Results:
* The return value is a standard Tcl completion code. If successful, a
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 83fb818..d6cd188 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -60,7 +60,7 @@ static TclFile FileForRedirect(Tcl_Interp *interp, const char *spec,
static TclFile
FileForRedirect(
- Tcl_Interp *interp, /* Intepreter to use for error reporting. */
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
const char *spec, /* Points to character just after redirection
* character. */
int atOK, /* Non-zero means that '@' notation can be
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index ea25d4b..eb23f72 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -502,9 +502,16 @@ Tcl_RegExpMatchObj(
{
Tcl_RegExp re;
- re = Tcl_GetRegExpFromObj(interp, patternObj,
- TCL_REG_ADVANCED | TCL_REG_NOSUB);
- if (re == NULL) {
+ /*
+ * For performance reasons, first try compiling the RE without support for
+ * subexpressions. On failure, try again without TCL_REG_NOSUB in case the
+ * RE has backreferences in it. Closely related to [Bug 1366683]. If this
+ * still fails, an error message will be left in the interpreter.
+ */
+
+ if (!(re = Tcl_GetRegExpFromObj(interp, patternObj,
+ TCL_REG_ADVANCED | TCL_REG_NOSUB))
+ && !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) {
return -1;
}
return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
diff --git a/tests/set-old.test b/tests/set-old.test
index 93169f1..309abaf 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -652,6 +652,13 @@ test set-old-8.52 {array command, array names -regexp on regexp pattern} {
set a(11) 1
list [catch {lsort [array names a -regexp ^1]} msg] $msg
} {0 {1*2 11 12}}
+test set-old-8.52.1 {array command, array names -regexp, backrefs} {
+ catch {unset a}
+ set a(1*2) 1
+ set a(12) 1
+ set a(11) 1
+ list [catch {lsort [array names a -regexp {^(.)\1}]} msg] $msg
+} {0 11}
test set-old-8.53 {array command, array names -regexp} {
catch {unset a}
set a(-glob) 1
diff --git a/tests/socket.test b/tests/socket.test
index 387e08e..c1076eb 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -283,7 +283,7 @@ test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket s
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -froboz
-} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, -server, -reuseaddr, or -reuseport}
+} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, -reuseaddr, -reuseport, or -server}
test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo -myport 2521 3333
} -returnCodes error -result {option -myport is not valid for servers}