summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/regc_nfa.c2
-rw-r--r--generic/regexec.c7
-rw-r--r--generic/tclAssembly.c9
-rw-r--r--generic/tclCompCmds.c19
-rw-r--r--generic/tclCompCmdsGR.c4
-rw-r--r--generic/tclCompCmdsSZ.c8
-rw-r--r--generic/tclCompile.c504
-rw-r--r--generic/tclCompile.h9
-rw-r--r--generic/tclEnsemble.c46
-rw-r--r--generic/tclParse.c1
-rw-r--r--generic/tclUtf.c2
-rw-r--r--tests/parse.test21
-rw-r--r--tests/reg.test3
-rw-r--r--tests/regexp.test4
-rw-r--r--tests/subst.test4
-rw-r--r--tests/unixForkEvent.test45
-rw-r--r--unix/Makefile.in10
-rwxr-xr-xunix/configure109
-rw-r--r--unix/configure.in1
-rw-r--r--unix/tcl.m46
-rw-r--r--unix/tclUnixNotfy.c113
-rw-r--r--unix/tclUnixThrd.c6
23 files changed, 246 insertions, 693 deletions
diff --git a/ChangeLog b/ChangeLog
index 40da8f9..644b871 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-08-01 Harald Oehlmann <oehhar@users.sf.net>
+
+ * tclUnixNotify.c Tcl_InitNotifier: Bug [a0bc856dcd]
+ Start notifier thread again if we were forked, to solve Rivet bug
+ 55153.
+
2013-07-05 Kevin B. Kenny <kennykb@acm.org>
* library/tzdata/Africa/Casablanca:
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index e36c5d2..4f62280 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -824,7 +824,7 @@ duptraverse(
* make all normal tests (not reg-33.14) pass.
*/
#ifndef DUPTRAVERSE_MAX_DEPTH
-#define DUPTRAVERSE_MAX_DEPTH 700
+#define DUPTRAVERSE_MAX_DEPTH 15000
#endif
if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
diff --git a/generic/regexec.c b/generic/regexec.c
index 9e6b04e..e65a02b 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -504,12 +504,7 @@ complicatedFindLoop(
return er;
}
if ((shorter) ? end == estop : end == begin) {
- /*
- * No point in trying again.
- */
-
- *coldp = cold;
- return REG_NOMATCH;
+ break;
}
/*
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 9b9b6f8..100e9ef 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -930,11 +930,9 @@ TclCompileAssembleCmd(
{
Tcl_Token *tokenPtr; /* Token in the input script */
-#if 1
int numCommands = envPtr->numCommands;
int offset = envPtr->codeNext - envPtr->codeStart;
int depth = envPtr->currStackDepth;
-#endif
/*
* Make sure that the command has a single arg that is a simple word.
@@ -956,7 +954,6 @@ TclCompileAssembleCmd(
if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
tokenPtr[1].size, TCL_EVAL_DIRECT)) {
-#if 1
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"%.*s\" body, line %d)",
parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
@@ -965,10 +962,6 @@ TclCompileAssembleCmd(
envPtr->codeNext = envPtr->codeStart + offset;
envPtr->currStackDepth = depth;
TclCompileSyntaxError(interp, envPtr);
-#else
- Tcl_ResetResult(interp);
- return TCL_ERROR;
-#endif
}
return TCL_OK;
}
@@ -3054,7 +3047,7 @@ ResolveJumpTableTargets(
auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
bbPtr, bbPtr->jumpOffset, auxDataIndex);
- realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+ realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex);
realJumpHashPtr = &realJumpTablePtr->hashTable;
/*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7fe0728..8edb2d9 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -87,6 +87,7 @@ TclCompileAppendCmd(
int isScalar, localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
+ /* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords == 1) {
return TCL_ERROR;
@@ -544,7 +545,6 @@ TclCompileCatchCmd(
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
int resultIndex, optsIndex, range;
- int initStackDepth = envPtr->currStackDepth;
DefineLineInformation; /* TIP #280 */
/*
@@ -742,15 +742,6 @@ TclCompileCatchCmd(
TclEmitOpcode( INST_POP, envPtr);
}
- /*
- * Result of all this, on either branch, should have been to leave one
- * operand -- the return code -- on the stack.
- */
-
- if (envPtr->currStackDepth != initStackDepth + 1) {
- Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
- envPtr->currStackDepth, initStackDepth+1);
- }
return TCL_OK;
}
@@ -983,6 +974,7 @@ TclCompileDictGetCmd(
* case is legal, but too special and magic for us to deal with here).
*/
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
@@ -1020,6 +1012,7 @@ TclCompileDictExistsCmd(
* case is legal, but too special and magic for us to deal with here).
*/
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
@@ -1057,6 +1050,7 @@ TclCompileDictUnsetCmd(
* compile to bytecode.
*/
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
@@ -1202,6 +1196,7 @@ TclCompileDictMergeCmd(
* argument, the only thing to do is to verify the dict-ness.
*/
+ /* TODO: Consider support for compiling expanded args. (less likely) */
if (parsePtr->numWords < 2) {
PushStringLiteral(envPtr, "");
return TCL_OK;
@@ -1722,6 +1717,7 @@ TclCompileDictAppendCmd(
* speed quite so much. ;-)
*/
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords<4 || parsePtr->numWords>100) {
return TCL_ERROR;
}
@@ -1774,6 +1770,8 @@ TclCompileDictLappendCmd(
* There must be three arguments after the command.
*/
+ /* TODO: Consider support for compiling expanded args. */
+ /* Probably not. Why is INST_DICT_LAPPEND limited to one value? */
if (parsePtr->numWords != 4) {
return TCL_ERROR;
}
@@ -1820,6 +1818,7 @@ TclCompileDictWithCmd(
* There must be at least one argument after the command.
*/
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index fc68509..150c378 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -60,6 +60,7 @@ TclCompileGlobalCmd(
int localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
+ /* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords < 2) {
return TCL_ERROR;
@@ -820,6 +821,7 @@ TclCompileLappendCmd(
return TCL_ERROR;
}
+ /* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords == 1) {
return TCL_ERROR;
@@ -1061,6 +1063,7 @@ TclCompileLindexCmd(
* Quit if too few args.
*/
+ /* TODO: Consider support for compiling expanded args. */
if (numWords <= 1) {
return TCL_ERROR;
}
@@ -1583,6 +1586,7 @@ TclCompileLsetCmd(
* Check argument count.
*/
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
/*
* Fail at run time, not in compilation.
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 320ed57..d1eb9db 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -991,9 +991,6 @@ TclSubstCompile(
* Instructions are added to envPtr to execute the "switch" command at
* runtime.
*
- * FIXME:
- * Stack depths are probably not calculated correctly.
- *
*----------------------------------------------------------------------
*/
@@ -2821,6 +2818,7 @@ TclCompileUnsetCmd(
Tcl_Obj *leadingWord;
DefineLineInformation; /* TIP #280 */
+ /* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords-1;
flags = 1;
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -3176,6 +3174,7 @@ CompileAssociativeBinaryOpCmd(
DefineLineInformation; /* TIP #280 */
int words;
+ /* TODO: Consider support for compiling expanded args. */
for (words=1 ; words<parsePtr->numWords ; words++) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, words);
@@ -3259,6 +3258,7 @@ CompileComparisonOpCmd(
Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
PUSH("1");
} else if (parsePtr->numWords == 3) {
@@ -3596,6 +3596,7 @@ TclCompileMinusOpCmd(
DefineLineInformation; /* TIP #280 */
int words;
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords == 1) {
/*
* Fallback to direct eval to report syntax error.
@@ -3641,6 +3642,7 @@ TclCompileDivOpCmd(
DefineLineInformation; /* TIP #280 */
int words;
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords == 1) {
/*
* Fallback to direct eval to report syntax error.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a52ad3e..772ce22 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -16,8 +16,6 @@
#include "tclCompile.h"
#include <assert.h>
-#define REWRITE
-
/*
* Table of all AuxData types.
*/
@@ -564,10 +562,6 @@ static void EnterCmdExtentData(CompileEnv *envPtr,
int cmdNumber, int numSrcBytes, int numCodeBytes);
static void EnterCmdStartData(CompileEnv *envPtr,
int cmdNumber, int srcOffset, int codeOffset);
-#ifndef REWRITE
-static Command * FindCompiledCommandFromToken(Tcl_Interp *interp,
- Tcl_Token *tokenPtr);
-#endif
static void FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int GetCmdLocEncodingSize(CompileEnv *envPtr);
@@ -1672,56 +1666,6 @@ TclWordKnownAtCompileTime(
return 1;
}
-#ifndef REWRITE
-/*
- * ---------------------------------------------------------------------
- *
- * FindCompiledCommandFromToken --
- *
- * A simple helper that looks up a command's compiler from its token.
- *
- * ---------------------------------------------------------------------
- */
-
-static Command *
-FindCompiledCommandFromToken(
- Tcl_Interp *interp,
- Tcl_Token *tokenPtr)
-{
- Tcl_DString ds;
- Command *cmdPtr;
-
- /*
- * If we have a non-trivial token or are suppressing compilation, we stop
- * right now.
- */
-
- if ((tokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
- || (((Interp *) interp)->flags & DONT_COMPILE_CMDS_INLINE)) {
- return NULL;
- }
-
- /*
- * We copy the string before trying to find the command by name. We used
- * to modify the string in place, but this is not safe because the name
- * resolution handlers could have side effects that rely on the unmodified
- * string.
- */
-
- Tcl_DStringInit(&ds);
- TclDStringAppendToken(&ds, &tokenPtr[1]);
- cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), NULL,
- /*flags*/ 0);
- if (cmdPtr != NULL && (cmdPtr->compileProc == NULL
- || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
- || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
- cmdPtr = NULL;
- }
- Tcl_DStringFree(&ds);
- return cmdPtr;
-}
-#endif
-
/*
*----------------------------------------------------------------------
*
@@ -1740,8 +1684,6 @@ FindCompiledCommandFromToken(
*----------------------------------------------------------------------
*/
-#ifdef REWRITE
-
static int
ExpandRequested(
Tcl_Token *tokenPtr,
@@ -2071,7 +2013,6 @@ CompileCommandTokens(
return cmdIdx;
}
-#endif
void
TclCompileScript(
@@ -2084,7 +2025,6 @@ TclCompileScript(
* first null character. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
-#ifdef REWRITE
int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last
* command this routine compiles into bytecode.
* Initial value of -1 indicates this routine
@@ -2115,6 +2055,7 @@ TclCompileScript(
#ifdef TCL_COMPILE_DEBUG
/*
* If tracing, print a line for each top level command compiled.
+ * TODO: Suppress when numWords == 0 ?
*/
if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
@@ -2198,449 +2139,6 @@ TclCompileScript(
envPtr->codeNext--;
envPtr->currStackDepth++;
}
-#else
- int lastTopLevelCmdIndex = -1;
- /* Index of most recent toplevel command in
- * the command location table. Initialized to
- * avoid compiler warning. */
- int startCodeOffset = -1; /* Offset of first byte of current command's
- * code. Init. to avoid compiler warning. */
- unsigned char *entryCodeNext = envPtr->codeNext;
- const char *p, *next;
- Command *cmdPtr;
- Tcl_Token *tokenPtr;
- int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
- /* TIP #280 */
- ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
- int *wlines, wlineat, cmdLine, *clNext;
- Tcl_Parse parse, *parsePtr = &parse;
-
- if (envPtr->iPtr == NULL) {
- Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
- }
-
- if (numBytes < 0) {
- numBytes = strlen(script);
- }
- Tcl_ResetResult(interp);
- isFirstCmd = 1;
-
- /*
- * Each iteration through the following loop compiles the next command
- * from the script.
- */
-
- p = script;
- bytesLeft = numBytes;
- cmdLine = envPtr->line;
- clNext = envPtr->clNext;
- do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
- /*
- * Compile bytecodes to report the parse error at runtime.
- */
-
- Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
- parsePtr->term + 1 - parsePtr->commandStart);
- TclCompileSyntaxError(interp, envPtr);
- break;
- }
-
- /*
- * TIP #280: We have to count newlines before the command even in the
- * degenerate case when the command has no words. (See test
- * info-30.33).
- * So make that counting here, and not in the (numWords > 0) branch
- * below.
- */
-
- TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
- TclAdvanceContinuations(&cmdLine, &clNext,
- parsePtr->commandStart - envPtr->source);
-
- if (parsePtr->numWords > 0) {
- int expand = 0; /* Set if there are dynamic expansions to
- * handle */
-
- /*
- * If not the first command, pop the previous command's result
- * and, if we're compiling a top level command, update the last
- * command's code size to account for the pop instruction.
- */
-
- if (!isFirstCmd) {
- TclEmitOpcode(INST_POP, envPtr);
- envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - startCodeOffset;
- }
-
- /*
- * Determine the actual length of the command.
- */
-
- commandLength = parsePtr->commandSize;
- if (parsePtr->term == parsePtr->commandStart + commandLength-1) {
- /*
- * The command terminator character (such as ; or ]) is the
- * last character in the parsed command. Reduce the length by
- * one so that the trace message doesn't include the
- * terminator character.
- */
-
- commandLength -= 1;
- }
-
-#ifdef TCL_COMPILE_DEBUG
- /*
- * If tracing, print a line for each top level command compiled.
- */
-
- if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
- fprintf(stdout, " Compiling: ");
- TclPrintSource(stdout, parsePtr->commandStart,
- TclMin(commandLength, 55));
- fprintf(stdout, "\n");
- }
-#endif
-
- /*
- * Check whether expansion has been requested for any of the
- * words.
- */
-
- for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
- wordIdx < parsePtr->numWords;
- wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
- if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
- expand = 1;
- break;
- }
- }
-
- /*
- * If expansion was requested, check if the command declares that
- * it knows how to compile it. Note that if expansion is requested
- * for the first word, this check will fail as the token type will
- * inhibit it. (Checked inside FindCompiledCommandFromToken.) This
- * is as it should be.
- */
-
- if (expand) {
- cmdPtr = FindCompiledCommandFromToken(interp,
- parsePtr->tokenPtr);
- if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
- expand = 0;
- }
- }
-
- envPtr->numCommands++;
- currCmdIndex = envPtr->numCommands - 1;
- lastTopLevelCmdIndex = currCmdIndex;
- startCodeOffset = envPtr->codeNext - envPtr->codeStart;
- EnterCmdStartData(envPtr, currCmdIndex,
- parsePtr->commandStart - envPtr->source, startCodeOffset);
-
- /*
- * Should only start issuing instructions after the "command has
- * started" so that the command range is correct in the bytecode.
- */
-
- if (expand) {
- StartExpanding(envPtr);
- }
-
- /*
- * TIP #280. Scan the words and compute the extended location
- * information. The map first contain full per-word line
- * information for use by the compiler. This is later replaced by
- * a reduced form which signals non-literal words, stored in
- * 'wlines'.
- */
-
- EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
- parsePtr->tokenPtr, parsePtr->commandStart,
- parsePtr->commandSize, parsePtr->numWords, cmdLine,
- clNext, &wlines, envPtr);
- wlineat = eclPtr->nuloc - 1;
-
- /*
- * Each iteration of the following loop compiles one word from the
- * command.
- */
-
- for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
- wordIdx < parsePtr->numWords; wordIdx++,
- tokenPtr += tokenPtr->numComponents + 1) {
- /*
- * Note the parse location information.
- */
-
- envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
- envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
-
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- /*
- * The word is not a simple string of characters.
- */
-
- CompileTokens(envPtr, tokenPtr, interp);
- if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
- TclEmitInstInt4(INST_EXPAND_STKTOP,
- envPtr->currStackDepth, envPtr);
- }
- continue;
- }
-
- /*
- * This is a simple string of literal characters (i.e. we know
- * it absolutely and can use it directly). If this is the
- * first word and the command has a compile procedure, let it
- * compile the command.
- */
-
- if ((wordIdx == 0) && !expand) {
- cmdPtr = FindCompiledCommandFromToken(interp, tokenPtr);
- if (cmdPtr) {
- int savedNumCmds = envPtr->numCommands;
- unsigned savedCodeNext =
- envPtr->codeNext - envPtr->codeStart;
- int update = 0;
- int startStackDepth = envPtr->currStackDepth;
-
- /*
- * Mark the start of the command; the proper bytecode
- * length will be updated later. There is no need to
- * do this for the first bytecode in the compile env,
- * as the check is done before calling
- * TclNRExecuteByteCode(). Do emit an INST_START_CMD
- * in special cases where the first bytecode is in a
- * loop, to insure that the corresponding command is
- * counted properly. Compilers for commands able to
- * produce such a beast (currently 'while 1' only) set
- * envPtr->atCmdStart to 0 in order to signal this
- * case. [Bug 1752146]
- *
- * Note that the environment is initialised with
- * atCmdStart=1 to avoid emitting ISC for the first
- * command.
- */
-
- if (envPtr->atCmdStart == 1) {
- if (savedCodeNext != 0) {
- /*
- * Increase the number of commands being
- * started at the current point. Note that
- * this depends on the exact layout of the
- * INST_START_CMD's operands, so be careful!
- */
-
- TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
- }
- } else if (envPtr->atCmdStart == 0) {
- TclEmitInstInt4(INST_START_CMD, 0, envPtr);
- TclEmitInt4(1, envPtr);
- update = 1;
- }
-
- if (cmdPtr->compileProc(interp, parsePtr, cmdPtr,
- envPtr) == TCL_OK) {
- /*
- * Confirm that the command compiler generated a
- * single value on the stack as its result. This
- * is only done in debugging mode, as it *should*
- * be correct and normal users have no reasonable
- * way to fix it anyway.
- */
-
-#ifdef TCL_COMPILE_DEBUG
- int diff = envPtr->currStackDepth-startStackDepth;
-
- if (diff != 1) {
- Tcl_Panic("bad stack adjustment when compiling"
- " %.*s (was %d instead of 1)",
- parsePtr->tokenPtr->size,
- parsePtr->tokenPtr->start, diff);
- }
-#endif
- if (update) {
- /*
- * Fix the bytecode length.
- */
-
- unsigned char *fixPtr = envPtr->codeStart
- + savedCodeNext + 1;
- unsigned fixLen = envPtr->codeNext
- - envPtr->codeStart - savedCodeNext;
-
- TclStoreInt4AtPtr(fixLen, fixPtr);
- }
- goto finishCommand;
- }
-
- if (envPtr->atCmdStart == 1 && savedCodeNext != 0) {
- /*
- * Decrease the number of commands being started
- * at the current point. Note that this depends on
- * the exact layout of the INST_START_CMD's
- * operands, so be careful!
- */
-
- TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
- }
-
- /*
- * Restore numCommands and codeNext to their correct
- * values, removing any commands compiled before the
- * failure to produce bytecode got reported. [Bugs
- * 705406 and 735055]
- */
-
- envPtr->numCommands = savedNumCmds;
- envPtr->codeNext = envPtr->codeStart + savedCodeNext;
-
- /*
- * And the stack depth too!! [Bug 3614102].
- */
-
- envPtr->currStackDepth = startStackDepth;
- }
-
- /*
- * No compile procedure so push the word. If the command
- * was found, push a CmdName object to reduce runtime
- * lookups. Mark this as a command name literal to reduce
- * shimmering.
- */
-
- objIndex = TclRegisterNewCmdLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size);
- if (cmdPtr) {
- TclSetCmdNameObj(interp,
- TclFetchLiteral(envPtr, objIndex), cmdPtr);
- }
- } else {
- /*
- * Simple argument word of a command. We reach this if and
- * only if the command word was not compiled for whatever
- * reason. Register the literal's location for use by
- * uplevel, etc. commands, should they encounter it
- * unmodified. We care only if the we are in a context
- * which already allows absolute counting.
- */
-
- objIndex = TclRegisterNewLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size);
-
- if (envPtr->clNext) {
- TclContinuationsEnterDerived(
- TclFetchLiteral(envPtr, objIndex),
- tokenPtr[1].start - envPtr->source,
- eclPtr->loc[wlineat].next[wordIdx]);
- }
- }
- TclEmitPush(objIndex, envPtr);
- } /* for loop */
-
- /*
- * Emit an invoke instruction for the command. We skip this if a
- * compile procedure was found for the command.
- */
- assert(wordIdx > 0);
-
- if (expand) {
- /*
- * The stack depth during argument expansion can only be
- * managed at runtime, as the number of elements in the
- * expanded lists is not known at compile time. We adjust here
- * the stack depth estimate so that it is correct after the
- * command with expanded arguments returns.
- *
- * The end effect of this command's invocation is that all the
- * words of the command are popped from the stack, and the
- * result is pushed: the stack top changes by (1-wordIdx).
- *
- * Note that the estimates are not correct while the command
- * is being prepared and run, INST_EXPAND_STKTOP is not
- * stack-neutral in general.
- */
-
- TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
- envPtr->expandCount--;
- TclAdjustStackDepth(1 - wordIdx, envPtr);
- } else {
- /*
- * Save PC -> command map for the TclArgumentBC* functions.
- */
-
- int isnew;
- Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
- INT2PTR(envPtr->codeNext - envPtr->codeStart),
- &isnew);
-
- Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
- if (wordIdx <= 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
- } else {
- TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
- }
- }
-
- /*
- * Update the compilation environment structure and record the
- * offsets of the source and code for the command.
- */
-
- finishCommand:
- EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
- (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
- isFirstCmd = 0;
-
- /*
- * TIP #280: Free full form of per-word line data and insert the
- * reduced form now
- */
-
- ckfree(eclPtr->loc[wlineat].line);
- ckfree(eclPtr->loc[wlineat].next);
- eclPtr->loc[wlineat].line = wlines;
- eclPtr->loc[wlineat].next = NULL;
- } /* end if parsePtr->numWords > 0 */
-
- /*
- * Advance to the next command in the script.
- */
-
- next = parsePtr->commandStart + parsePtr->commandSize;
- bytesLeft -= next - p;
- p = next;
-
- /*
- * TIP #280: Track lines in the just compiled command.
- */
-
- TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
- TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
- Tcl_FreeParse(parsePtr);
- } while (bytesLeft > 0);
-
- /*
- * TIP #280: Bring the line counts in the CompEnv up to date.
- * See tests info-30.33,34,35 .
- */
-
- envPtr->line = cmdLine;
- envPtr->clNext = clNext;
-
- /*
- * If the source script yielded no instructions (e.g., if it was empty),
- * push an empty string as the command's result.
- */
-
- if (envPtr->codeNext == entryCodeNext) {
- PushStringLiteral(envPtr, "");
- }
-#endif
}
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 3fc3317..8a8f322 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1113,6 +1113,15 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
*----------------------------------------------------------------
*/
+/*
+ * Simplified form to access AuxData.
+ *
+ * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
+ */
+
+#define TclFetchAuxData(envPtr, index) \
+ (envPtr)->auxDataArrayPtr[(index)].clientData
+
#define LITERAL_ON_HEAP 0x01
#define LITERAL_CMD_NAME 0x02
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 9033a1c..d1a788f 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3205,7 +3205,6 @@ CompileBasicNArgCommand(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
-#if 1
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_IncrRefCount(objPtr);
@@ -3213,51 +3212,6 @@ CompileBasicNArgCommand(
TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
parsePtr->numWords, envPtr);
Tcl_DecrRefCount(objPtr);
-#else
- Tcl_Token *tokenPtr;
- Tcl_Obj *objPtr;
- char *bytes;
- int length, i, literal;
- DefineLineInformation;
-
- /*
- * Push the name of the command we're actually dispatching to as part of
- * the implementation.
- */
-
- objPtr = Tcl_NewObj();
- Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
- bytes = Tcl_GetStringFromObj(objPtr, &length);
- literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
- TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, literal), cmdPtr);
- TclEmitPush(literal, envPtr);
- TclDecrRefCount(objPtr);
-
- /*
- * Push the words of the command.
- */
-
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- for (i=1 ; i<parsePtr->numWords ; i++) {
- if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
- } else {
- SetLineInformation(i);
- CompileTokens(envPtr, tokenPtr, interp);
- }
- tokenPtr = TokenAfter(tokenPtr);
- }
-
- /*
- * Do the standard dispatch.
- */
-
- if (i <= 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, i, envPtr);
- } else {
- TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
- }
-#endif
return TCL_OK;
}
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 08615a7..6723d39 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1567,6 +1567,7 @@ Tcl_ParseVar(
code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
NULL, 1, NULL, NULL);
+ Tcl_FreeParse(parsePtr);
TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 39fc12e..48a56cd 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1558,7 +1558,7 @@ Tcl_UniCharIsSpace(
return TclIsSpaceProc((char) ch);
} else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
|| (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
- || (Tcl_UniChar) ch == 0xfeff) {
+ || (Tcl_UniChar) ch == 0x202f || (Tcl_UniChar) ch == 0xfeff) {
return 1;
} else {
return ((SPACE_BITS >> GetCategory(ch)) & 1);
diff --git a/tests/parse.test b/tests/parse.test
index b9cfe80..9f2d50b 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -27,6 +27,7 @@ testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevent [llength [info commands testevent]]
+testConstraint memory [llength [info commands memory]]
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
@@ -678,6 +679,26 @@ test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar
unset -nocomplain abc
list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
} {1 {invalid command name "bogus"}}
+test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup {
+ proc getbytes {} {
+ return [lindex [split [memory info] \n] 3 3]
+ }
+} -body {
+ set a() foo
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ set vn {}
+ set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]]
+ if {$res ne {foo bar}} {error "Unexpected result: $res"}
+
+ set tmp $end
+ set end [getbytes]
+ }
+ expr {$end - $tmp}
+} -cleanup {
+ unset -nocomplain a end i vn res tmp
+ rename getbytes {}
+} -result 0
test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
diff --git a/tests/reg.test b/tests/reg.test
index b653d4b..5cc81fe 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -1149,6 +1149,9 @@ test reg-33.15 {Bug 3603557 - an "in the wild" RE} {
(.*) # ConditionalFields
}] 0
} 68
+test reg-33.16 {Bug [8d2c0da36d]- another "in the wild" RE} {
+ lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:kelly@hotbox.com 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 16Hkelly@hotbox.com 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0
+} 1
# cleanup
::tcltest::cleanupTests
diff --git a/tests/regexp.test b/tests/regexp.test
index 1c30001..1b2bec9 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -876,6 +876,10 @@ test regexp-22.5 {Bug 3610026} -setup {
} -cleanup {
unset -nocomplain e cp
} -returnCodes error -match glob -result {*too many colors*}
+test regexp-22.6 {Bug 6585b21ca8} {
+ expr {[regexp {(\w).*?\1} Programmer m] ? $m : "<NONE>"}
+} rogr
+
test regexp-23.1 {regexp -all and -line} {
set string ""
diff --git a/tests/subst.test b/tests/subst.test
index 4be4798..7466895 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -293,6 +293,10 @@ test subst-13.1 {Bug 3081065} -setup {
} -cleanup {
removeFile subst13.tcl
}
+test subst-13.2 {Test for segfault} -body {
+ subst {[}
+} -returnCodes error -result * -match glob
+
# cleanup
::tcltest::cleanupTests
diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
new file mode 100644
index 0000000..cbe582e
--- /dev/null
+++ b/tests/unixForkEvent.test
@@ -0,0 +1,45 @@
+# This file contains a collection of tests for the procedures in the file
+# tclUnixNotify.c. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+testConstraint testfork [llength [info commands testfork]]
+
+# Test if the notifier thread is well initialized in a forked interpreter
+# by Tcl_InitNotifier
+test unixforkevent-1.1 {fork and test writeable event} \
+ -constraints testfork \
+ -body {
+ set myFolder [makeDirectory unixtestfork]
+ set pid [testfork]
+ if {$pid == 0} {
+ # we are the forked process
+ set result initialized
+ set h [open [file join $myFolder test.txt] w]
+ fileevent $h writable\
+ "set result writable;\
+ after cancel [after 1000 {set result timeout}]"
+ vwait result
+ close $h
+ makeFile $result result.txt $myFolder
+ exit
+ }
+ # we are the original process
+ while {![file readable [file join $myFolder result.txt]]} {}
+ viewFile result.txt $myFolder
+ } \
+ -result {writable} \
+ -cleanup {
+ catch { removeFolder $myFolder }
+ }
+
+::tcltest::cleanupTests
+return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 01406aa..1e8f7e2 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -335,7 +335,10 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
-STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
+STUB_LIB_OBJS = tclStubLib.o \
+ tclTomMathStubLib.o \
+ tclOOStubLib.o \
+ ${COMPAT_OBJS}
UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
@@ -346,6 +349,8 @@ NOTIFY_OBJS = tclUnixNotfy.o
MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o
+CYGWIN_OBJS = tclWinError.o
+
DTRACE_OBJ = tclDTrace.o
ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \
@@ -575,6 +580,9 @@ MAC_OSX_SRCS = \
$(MAC_OSX_DIR)/tclMacOSXFCmd.c \
$(MAC_OSX_DIR)/tclMacOSXNotify.c
+CYGWIN_SRCS = \
+ $(TOP_DIR)/win/tclWinError.c
+
DTRACE_HDR = tclDTrace.h
DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d
diff --git a/unix/configure b/unix/configure
index 23c395c..6edeccd 100755
--- a/unix/configure
+++ b/unix/configure
@@ -4821,7 +4821,8 @@ echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you m
# Does the pthread-implementation provide
# 'pthread_attr_setstacksize' ?
-for ac_func in pthread_attr_setstacksize
+
+for ac_func in pthread_attr_setstacksize pthread_atfork
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
@@ -4949,108 +4950,6 @@ echo "${ECHO_T}no" >&6
-for ac_func in pthread_atfork
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
- cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-
#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------
@@ -7170,7 +7069,9 @@ fi
SHLIB_CFLAGS=""
SHLIB_LD='${CC} -shared'
SHLIB_SUFFIX=".dll"
- DL_OBJS="tclLoadDl.o tclWinError.o"
+ DL_OBJS="tclLoadDl.o"
+ PLAT_OBJS='${CYGWIN_OBJS}'
+ PLAT_SRCS='${CYGWIN_SRCS}'
DL_LIBS="-ldl"
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
diff --git a/unix/configure.in b/unix/configure.in
index 7554510..e2daccd 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -121,7 +121,6 @@ fi
#------------------------------------------------------------------------
SC_ENABLE_THREADS
-AC_CHECK_FUNCS(pthread_atfork)
#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 0b3cb68..a7c6b2d 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -676,7 +676,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [
# Does the pthread-implementation provide
# 'pthread_attr_setstacksize' ?
- AC_CHECK_FUNCS(pthread_attr_setstacksize)
+ AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
else
TCL_THREADS=0
fi
@@ -1224,7 +1224,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
SHLIB_CFLAGS=""
SHLIB_LD='${CC} -shared'
SHLIB_SUFFIX=".dll"
- DL_OBJS="tclLoadDl.o tclWinError.o"
+ DL_OBJS="tclLoadDl.o"
+ PLAT_OBJS='${CYGWIN_OBJS}'
+ PLAT_SRCS='${CYGWIN_SRCS}'
DL_LIBS="-ldl"
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 39e546a..7b9436a 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -120,6 +120,15 @@ static Tcl_ThreadDataKey dataKey;
static int notifierCount = 0;
/*
+ * The following static stores the process ID of the initialized notifier
+ * thread. If it changes, we have passed a fork and we should start a new
+ * notifier thread.
+ *
+ * You must hold the notifierMutex lock before accessing this variable.
+ */
+static pid_t processIDInitialized = 0;
+
+/*
* The following variable points to the head of a doubly-linked list of
* ThreadSpecificData structures for all threads that are currently waiting on
* an event.
@@ -185,7 +194,13 @@ static Tcl_ThreadId notifierThread;
#ifdef TCL_THREADS
static void NotifierThreadProc(ClientData clientData);
-#endif
+#ifdef HAVE_PTHREAD_ATFORK
+static int atForkInit = 0;
+static void AtForkPrepare(void);
+static void AtForkParent(void);
+static void AtForkChild(void);
+#endif /* HAVE_PTHREAD_ATFORK */
+#endif /* TCL_THREADS */
static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
/*
@@ -275,11 +290,38 @@ Tcl_InitNotifier(void)
*/
Tcl_MutexLock(&notifierMutex);
+#ifdef HAVE_PTHREAD_ATFORK
+ /*
+ * Install pthread_atfork handlers to reinitialize the notifier in the
+ * child of a fork.
+ */
+
+ if (!atForkInit) {
+ int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
+
+ if (result) {
+ Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
+ }
+ atForkInit = 1;
+ }
+#endif
+ /*
+ * Check if my process id changed, e.g. I was forked
+ * In this case, restart the notifier thread and close the
+ * pipe to the original notifier thread
+ */
+ if (notifierCount > 0 && processIDInitialized != getpid()) {
+ notifierCount = 0;
+ processIDInitialized = 0;
+ close(triggerPipe);
+ triggerPipe = -1;
+ }
if (notifierCount == 0) {
if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
}
+ processIDInitialized = getpid();
}
notifierCount++;
@@ -1270,6 +1312,75 @@ NotifierThreadProc(
TclpThreadExit(0);
}
+
+#ifdef HAVE_PTHREAD_ATFORK
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkPrepare --
+ *
+ * Lock the notifier in preparation for a fork.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkPrepare(void)
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkParent --
+ *
+ * Unlock the notifier in the parent after a fork.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkParent(void)
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkChild --
+ *
+ * Unlock and reinstall the notifier in the child after a fork.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkChild(void)
+{
+ notifierMutex = NULL;
+ notifierCV = NULL;
+ Tcl_InitNotifier();
+}
+#endif /* HAVE_PTHREAD_ATFORK */
+
#endif /* TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index e8c86b6..c943b77 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -15,12 +15,6 @@
#ifdef TCL_THREADS
-typedef struct {
- char nabuf[16];
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
/*
* masterLock is used to serialize creation of mutexes, condition variables,
* and thread local storage. This is the only place that can count on the