merge trunk

22 files changed, 61 insertions, 68 deletions

diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index affcb48..4c8f15f 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -457,7 +457,7 @@ next(
 	    if (ATEOS()) {
 		FAILW(REG_EESCAPE);
 	    }
-	    (DISCARD)lexescape(v);
+	    (void)lexescape(v);
 	    switch (v->nexttype) {	/* not all escapes okay here */
 	    case PLAIN:
 		return 1;
@@ -716,7 +716,7 @@ next(
 	}
 	RETV(PLAIN, *v->now++);
     }
-    (DISCARD)lexescape(v);
+    (void)lexescape(v);
     if (ISERR()) {
 	FAILW(REG_EESCAPE);
     }
@@ -1143,7 +1143,7 @@ skip(
 /*
  - newline - return the chr for a newline
  * This helps confine use of CHR to this source file.
- ^ static chr newline(NOPARMS);
+ ^ static chr newline(void);
  */
 static chr
 newline(void)
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index a6958fe..ab3b7f1 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -1227,7 +1227,7 @@ cmp(
     const chr *x, const chr *y,	/* strings to compare */
     size_t len)			/* exact length of comparison */
 {
-    return memcmp(VS(x), VS(y), len*sizeof(chr));
+    return memcmp((void*)(x), (void*)(y), len*sizeof(chr));
 }
 
 /*
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 088c6c0..240fcfe 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -843,7 +843,7 @@ moveins(
 
 /*
  - copyins - copy in arcs of a state to another state
- ^ static VOID copyins(struct nfa *, struct state *, struct state *, int);
+ ^ static void copyins(struct nfa *, struct state *, struct state *, int);
  */
 static void
 copyins(
@@ -1100,7 +1100,7 @@ moveouts(
 
 /*
  - copyouts - copy out arcs of a state to another state
- ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int);
+ ^ static void copyouts(struct nfa *, struct state *, struct state *, int);
  */
 static void
 copyouts(
diff --git a/generic/regcomp.c b/generic/regcomp.c
index 211cd70..58d55fb 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -82,7 +82,7 @@ static int lexescape(struct vars *);
 static int lexdigits(struct vars *, int, int, int);
 static int brenext(struct vars *, pchr);
 static void skip(struct vars *);
-static chr newline(NOPARMS);
+static chr newline(void);
 static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
 /* === regc_color.c === */
 static void initcm(struct vars *, struct colormap *);
@@ -341,13 +341,13 @@ compile(
     re->re_info = 0;		/* bits get set during parse */
     re->re_csize = sizeof(chr);
     re->re_guts = NULL;
-    re->re_fns = VS(&functions);
+    re->re_fns = (void*)(&functions);
 
     /*
      * More complex setup, malloced things.
      */
 
-    re->re_guts = VS(MALLOC(sizeof(struct guts)));
+    re->re_guts = (void*)(MALLOC(sizeof(struct guts)));
     if (re->re_guts == NULL) {
 	return freev(v, REG_ESPACE);
     }
@@ -434,7 +434,7 @@ compile(
      * Can sacrifice main NFA now, so use it as work area.
      */
 
-    (DISCARD) optimize(v->nfa, debug);
+    (void) optimize(v->nfa, debug);
     CNOERR();
     makesearch(v, v->nfa);
     CNOERR();
@@ -1920,10 +1920,10 @@ nfatree(
     assert(t != NULL && t->begin != NULL);
 
     if (t->left != NULL) {
-	(DISCARD) nfatree(v, t->left, f);
+	(void) nfatree(v, t->left, f);
     }
     if (t->right != NULL) {
-	(DISCARD) nfatree(v, t->right, f);
+	(void) nfatree(v, t->right, f);
     }
 
     return nfanode(v, t, f);
diff --git a/generic/regcustom.h b/generic/regcustom.h
index 681b97d..1f00bf4 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -37,9 +37,9 @@
  */
 
 #define	FUNCPTR(name, args)	(*name)args
-#define	MALLOC(n)		VS(attemptckalloc(n))
-#define	FREE(p)			ckfree(VS(p))
-#define	REALLOC(p,n)		VS(attemptckrealloc(VS(p),n))
+#define	MALLOC(n)		(void*)(attemptckalloc(n))
+#define	FREE(p)			ckfree((void*)(p))
+#define	REALLOC(p,n)		(void*)(attemptckrealloc((void*)(p),n))
 
 /*
  * Do not insert extras between the "begin" and "end" lines - this chunk is
diff --git a/generic/regexec.c b/generic/regexec.c
index 6d12827..128d439 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -44,7 +44,7 @@ struct sset {			/* state set */
     unsigned hash;		/* hash of bitvector */
 #define	HASH(bv, nw)	(((nw) == 1) ? *(bv) : hash(bv, nw))
 #define	HIT(h,bv,ss,nw)	((ss)->hash == (h) && ((nw) == 1 || \
-	memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
+	memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0))
     int flags;
 #define	STARTER		01	/* the initial state set */
 #define	POSTSTATE	02	/* includes the goal state */
@@ -268,7 +268,7 @@ exec(
     if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
 	zapallsubs(pmatch, nmatch);
 	n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
-	memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
+	memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t));
     }
 
     /*
diff --git a/generic/regguts.h b/generic/regguts.h
index 1ac2465..9461136 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -49,23 +49,6 @@
 #include <assert.h>
 #endif
 
-/* voids */
-#ifndef VOID
-#define	VOID	void		/* for function return values */
-#endif
-#ifndef DISCARD
-#define	DISCARD	void		/* for throwing values away */
-#endif
-#ifndef PVOID
-#define	PVOID	void *		/* generic pointer */
-#endif
-#ifndef VS
-#define	VS(x)	((void*)(x))	/* cast something to generic ptr */
-#endif
-#ifndef NOPARMS
-#define	NOPARMS	void		/* for empty parm lists */
-#endif
-
 /* function-pointer declarator */
 #ifndef FUNCPTR
 #if __STDC__ >= 1
@@ -80,10 +63,10 @@
 #define	MALLOC(n)	malloc(n)
 #endif
 #ifndef REALLOC
-#define	REALLOC(p, n)	realloc(VS(p), n)
+#define	REALLOC(p, n)	realloc(p, n)
 #endif
 #ifndef FREE
-#define	FREE(p)		free(VS(p))
+#define	FREE(p)		free(p)
 #endif
 
 /* want size of a char in bits, and max value in bounded quantifiers */
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 37d7e21..f60c9cc 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;
@@ -3400,8 +3400,7 @@ TclCleanupCommand(
     register Command *cmdPtr)	/* Points to the Command structure to
 				 * be freed. */
 {
-    cmdPtr->refCount--;
-    if (cmdPtr->refCount <= 0) {
+    if (cmdPtr->refCount-- <= 1) {
 	ckfree(cmdPtr);
     }
 }
@@ -5583,8 +5582,7 @@ TclArgumentRelease(
 	}
 	cfwPtr = Tcl_GetHashValue(hPtr);
 
-	cfwPtr->refCount--;
-	if (cfwPtr->refCount > 0) {
+	if (cfwPtr->refCount-- > 1) {
 	    continue;
 	}
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 6f64ee9..9048c39 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.c b/generic/tclCompile.c
index 149c179..d20940c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1006,7 +1006,7 @@ void
 TclReleaseByteCode(
     register ByteCode *codePtr)
 {
-    if (--codePtr->refCount) {
+    if (codePtr->refCount-- > 1) {
 	return;
     }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 825fff6..a309182 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/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/tclIOGT.c b/generic/tclIOGT.c
index 7f61def..c1e8c44 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -211,7 +211,7 @@ struct TransformChannelData {
 				 * a transformation of incoming data. Also
 				 * serves as buffer of all data not yet
 				 * consumed by the reader. */
-    int refCount;
+    size_t refCount;
 };
 
 static void
@@ -225,7 +225,7 @@ static void
 ReleaseData(
     TransformChannelData *dataPtr)
 {
-    if (--dataPtr->refCount) {
+    if (dataPtr->refCount-- > 1) {
 	return;
     }
     ResultClear(&dataPtr->result);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0d1e4a2..af289f9 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/tclNamesp.c b/generic/tclNamesp.c
index 7aacf7f..b1b486a 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -33,7 +33,7 @@
  */
 
 typedef struct ThreadSpecificData {
-    long numNsCreated;		/* Count of the number of namespaces created
+    size_t numNsCreated;	/* Count of the number of namespaces created
 				 * within the thread. This value is used as a
 				 * unique id for each namespace. Cannot be
 				 * per-interp because the nsId is used to
@@ -60,7 +60,7 @@ typedef struct ResolvedNsName {
 				 * the name was resolved. NULL if the name is
 				 * fully qualified and thus the resolution
 				 * does not depend on the context. */
-    int refCount;		/* Reference count: 1 for each nsName object
+    size_t refCount;		/* Reference count: 1 for each nsName object
 				 * that has a pointer to this ResolvedNsName
 				 * structure as its internal rep. This
 				 * structure can be freed when refCount
@@ -1343,8 +1343,7 @@ void
 TclNsDecrRefCount(
     Namespace *nsPtr)
 {
-    nsPtr->refCount--;
-    if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+    if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
 	NamespaceFree(nsPtr);
     }
 }
@@ -4694,8 +4693,7 @@ FreeNsNameInternalRep(
      * references, free it up.
      */
 
-    resNamePtr->refCount--;
-    if (resNamePtr->refCount == 0) {
+    if (resNamePtr->refCount-- <= 1) {
 	/*
 	 * Decrement the reference count for the cached namespace. If the
 	 * namespace is dead, and there are no more references to it, free
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 9d7c619..50e3f3a 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -362,7 +362,7 @@ typedef struct ResolvedCmdName {
 				 * incremented; if so, the cmd was renamed,
 				 * deleted, hidden, or exposed, and so the
 				 * pointer is invalid. */
-    int refCount;		/* Reference count: 1 for each cmdName object
+    size_t refCount;		/* Reference count: 1 for each cmdName object
 				 * that has a pointer to this ResolvedCmdName
 				 * structure as its internal rep. This
 				 * structure can be freed when refCount
@@ -4508,7 +4508,7 @@ FreeCmdNameInternalRep(
 	 * there are no more uses, free the ResolvedCmdName structure.
 	 */
 
-	if (resPtr->refCount-- == 1) {
+	if (resPtr->refCount-- <= 1) {
 	    /*
 	     * Now free the cached command, unless it is still in its hash
 	     * table or if there are other references to it from other cmdName
@@ -4620,7 +4620,7 @@ SetCmdNameFromAny(
 
 	Command *oldCmdPtr = resPtr->cmdPtr;
 
-	if (--oldCmdPtr->refCount == 0) {
+	if (oldCmdPtr->refCount-- <= 1) {
 	    TclCleanupCommandMacro(oldCmdPtr);
 	}
     } else {
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/tclPreserve.c b/generic/tclPreserve.c
index cca13e8..2d0e15c 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -22,7 +22,7 @@
 
 typedef struct {
     ClientData clientData;	/* Address of preserved block. */
-    int refCount;		/* Number of Tcl_Preserve calls in effect for
+    size_t refCount;		/* Number of Tcl_Preserve calls in effect for
 				 * block. */
     int mustFree;		/* Non-zero means Tcl_EventuallyFree was
 				 * called while a Tcl_Preserve call was in
@@ -63,7 +63,7 @@ typedef struct HandleStruct {
 				 * ensure that the contents of the handle are
 				 * not changed by anyone else. */
 #endif
-    int refCount;		/* Number of TclHandlePreserve() calls in
+    size_t refCount;		/* Number of TclHandlePreserve() calls in
 				 * effect on this handle. */
 } HandleStruct;
 
@@ -195,7 +195,7 @@ Tcl_Release(
 	    continue;
 	}
 
-	if (--refPtr->refCount != 0) {
+	if (refPtr->refCount-- > 1) {
 	    Tcl_MutexUnlock(&preserveMutex);
 	    return;
 	}
@@ -459,7 +459,7 @@ TclHandleRelease(
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
-    if ((--handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
+    if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
 	ckfree(handlePtr);
     }
 }
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 6845f7d..7596fa0 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -520,9 +520,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/generic/tclTrace.c b/generic/tclTrace.c
index 0c73cba..bea3162 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -52,7 +52,7 @@ typedef struct {
 				 * invoked step trace */
     int curFlags;		/* Trace flags for the current command */
     int curCode;		/* Return code for the current command */
-    int refCount;		/* Used to ensure this structure is not
+    size_t refCount;		/* Used to ensure this structure is not
 				 * deleted too early. Keeps track of how many
 				 * pieces of code have a pointer to this
 				 * structure. */
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