Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | novem |
Files: | files | file ages | folders |
SHA1: |
396ccb299c1e0c338717c05364e26ce8 |
User & Date: | jan.nijtmans 2013-08-02 10:33:28 |
2013-08-13
| ||
19:26 | [0aa8f12dcc] Restore minimum code to stop failing tests. check-in: a64f1e873a user: dgp tags: novem | |
2013-08-02
| ||
10:33 | merge trunk check-in: 396ccb299c user: jan.nijtmans tags: novem | |
2013-08-01
| ||
19:18 | [1905562] [8d2c0da36d] Raise the recursion limits on regexps to allow existing regexps "in the wild"... check-in: b7100ded1f user: dgp tags: trunk | |
2013-07-23
| ||
09:49 | merge trunk check-in: 2dd21b756d user: jan.nijtmans tags: novem | |
Changes to ChangeLog.
1 2 3 4 5 6 7 | 2013-07-05 Kevin B. Kenny <[email protected]> * library/tzdata/Africa/Casablanca: * library/tzdata/America/Asuncion: * library/tzdata/Antarctica/Macquarie: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Hebron: | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 | 2013-08-01 Harald Oehlmann <[email protected]> * 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 <[email protected]> * library/tzdata/Africa/Casablanca: * library/tzdata/America/Asuncion: * library/tzdata/Antarctica/Macquarie: * library/tzdata/Asia/Gaza: * library/tzdata/Asia/Hebron: |
︙ | ︙ |
Changes to generic/regc_nfa.c.
︙ | ︙ | |||
820 821 822 823 824 825 826 | } /* * Arbitrary depth limit. Needs tuning, but this value is sufficient to * make all normal tests (not reg-33.14) pass. */ #ifndef DUPTRAVERSE_MAX_DEPTH | | | 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 | } /* * Arbitrary depth limit. Needs tuning, but this value is sufficient to * make all normal tests (not reg-33.14) pass. */ #ifndef DUPTRAVERSE_MAX_DEPTH #define DUPTRAVERSE_MAX_DEPTH 15000 #endif if (depth++ > DUPTRAVERSE_MAX_DEPTH) { NERR(REG_ESPACE); } for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) { |
︙ | ︙ |
Changes to generic/regexec.c.
︙ | ︙ | |||
500 501 502 503 504 505 506 | return REG_OKAY; } if (er != REG_NOMATCH) { ERR(er); return er; } if ((shorter) ? end == estop : end == begin) { | < < < | < < | 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 | return REG_OKAY; } if (er != REG_NOMATCH) { ERR(er); return er; } if ((shorter) ? end == estop : end == begin) { break; } /* * Go around and try again */ if (shorter) { |
︙ | ︙ |
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
926 927 928 929 930 931 932 | * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Token in the input script */ | < < | 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 | * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Token in the input script */ int numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; int depth = envPtr->currStackDepth; /* * Make sure that the command has a single arg that is a simple word. */ if (parsePtr->numWords != 2) { return TCL_ERROR; |
︙ | ︙ | |||
952 953 954 955 956 957 958 | * Compile the code and convert any error from the compilation into * bytecode reporting the error; */ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, TCL_EVAL_DIRECT)) { | < < < < < | 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 | * Compile the code and convert any error from the compilation into * bytecode reporting the error; */ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, TCL_EVAL_DIRECT)) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, Tcl_GetErrorLine(interp))); envPtr->numCommands = numCommands; envPtr->codeNext = envPtr->codeStart + offset; envPtr->currStackDepth = depth; TclCompileSyntaxError(interp, envPtr); } return TCL_OK; } /* *----------------------------------------------------------------------------- * |
︙ | ︙ | |||
3050 3051 3052 3053 3054 3055 3056 | BasicBlock* jumpTargetBBPtr; /* Basic block that the jump proceeds to */ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); | | | 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 | BasicBlock* jumpTargetBBPtr; /* Basic block that the jump proceeds to */ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex); realJumpHashPtr = &realJumpTablePtr->hashTable; /* * Look up every jump target in the jump hash. */ DEBUG_PRINT("resolve jump table {\n"); |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
︙ | ︙ | |||
83 84 85 86 87 88 89 90 91 92 93 94 95 96 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int isScalar, localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; } else if (numWords == 2) { /* * append varName == set varName */ | > | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int isScalar, localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; } else if (numWords == 2) { /* * append varName == set varName */ |
︙ | ︙ | |||
540 541 542 543 544 545 546 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; int resultIndex, optsIndex, range; | < | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; int resultIndex, optsIndex, range; DefineLineInformation; /* TIP #280 */ /* * If syntax does not match what we expect for [catch], do not compile. * Let runtime checks determine if syntax has changed. */ |
︙ | ︙ | |||
738 739 740 741 742 743 744 | */ if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_POP, envPtr); } | < < < < < < < < < | 738 739 740 741 742 743 744 745 746 747 748 749 750 751 | */ if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_POP, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileContinueCmd -- |
︙ | ︙ | |||
979 980 981 982 983 984 985 986 987 988 989 990 991 992 | DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command (the single-arg * case is legal, but too special and magic for us to deal with here). */ if (parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); numWords = parsePtr->numWords-1; /* | > | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command (the single-arg * 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; } tokenPtr = TokenAfter(parsePtr->tokenPtr); numWords = parsePtr->numWords-1; /* |
︙ | ︙ | |||
1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 | DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command (the single-arg * case is legal, but too special and magic for us to deal with here). */ if (parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); numWords = parsePtr->numWords-1; /* | > | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 | DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command (the single-arg * 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; } tokenPtr = TokenAfter(parsePtr->tokenPtr); numWords = parsePtr->numWords-1; /* |
︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 | int i, dictVarIndex; /* * There must be at least one argument after the variable name for us to * compile to bytecode. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } /* * The dictionary variable must be a local scalar that is knowable at * compile time; anything else exceeds the complexity of the opcode. So | > | 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 | int i, dictVarIndex; /* * There must be at least one argument after the variable name for us to * compile to bytecode. */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } /* * The dictionary variable must be a local scalar that is knowable at * compile time; anything else exceeds the complexity of the opcode. So |
︙ | ︙ | |||
1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 | int i, workerIndex, infoIndex, outLoop; /* * Deal with some special edge cases. Note that in the case with one * argument, the only thing to do is to verify the dict-ness. */ if (parsePtr->numWords < 2) { PushStringLiteral(envPtr, ""); return TCL_OK; } else if (parsePtr->numWords == 2) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); | > | 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 | int i, workerIndex, infoIndex, outLoop; /* * Deal with some special edge cases. Note that in the case with one * 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; } else if (parsePtr->numWords == 2) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); |
︙ | ︙ | |||
1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 | /* * There must be at least two argument after the command. And we impose an * (arbirary) safe limit; anyone exceeding it should stop worrying about * speed quite so much. ;-) */ if (parsePtr->numWords<4 || parsePtr->numWords>100) { return TCL_ERROR; } /* * Get the index of the local variable that we will be working with. */ | > | 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 | /* * There must be at least two argument after the command. And we impose an * (arbirary) safe limit; anyone exceeding it should stop worrying about * speed quite so much. ;-) */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords<4 || parsePtr->numWords>100) { return TCL_ERROR; } /* * Get the index of the local variable that we will be working with. */ |
︙ | ︙ | |||
1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 | Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; int dictVarIndex; /* * There must be three arguments after the command. */ if (parsePtr->numWords != 4) { return TCL_ERROR; } /* * Parse the arguments. */ | > > | 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 | Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; int dictVarIndex; /* * 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; } /* * Parse the arguments. */ |
︙ | ︙ | |||
1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 | JumpFixup jumpFixup; const char *ptr, *end; /* * There must be at least one argument after the command. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } /* * Parse the command (trivially). Expect the following: * dict with <any (varName)> ?<any> ...? <literal> | > | 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 | JumpFixup jumpFixup; const char *ptr, *end; /* * There must be at least one argument after the command. */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } /* * Parse the command (trivially). Expect the following: * dict with <any (varName)> ?<any> ...? <literal> |
︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
︙ | ︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if (numWords < 2) { return TCL_ERROR; } /* * 'global' has no effect outside of proc bodies; handle that at runtime | > | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords < 2) { return TCL_ERROR; } /* * 'global' has no effect outside of proc bodies; handle that at runtime |
︙ | ︙ | |||
816 817 818 819 820 821 822 823 824 825 826 827 828 829 | * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { return TCL_ERROR; } numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; } if (numWords != 3) { /* * LAPPEND instructions currently only handle one value, but we can | > | 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 | * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { return TCL_ERROR; } /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; } if (numWords != 3) { /* * LAPPEND instructions currently only handle one value, but we can |
︙ | ︙ | |||
1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 | int i, numWords = parsePtr->numWords; DefineLineInformation; /* TIP #280 */ /* * Quit if too few args. */ if (numWords <= 1) { return TCL_ERROR; } valTokenPtr = TokenAfter(parsePtr->tokenPtr); if (numWords != 3) { goto emitComplexLindex; | > | 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 | int i, numWords = parsePtr->numWords; DefineLineInformation; /* TIP #280 */ /* * Quit if too few args. */ /* TODO: Consider support for compiling expanded args. */ if (numWords <= 1) { return TCL_ERROR; } valTokenPtr = TokenAfter(parsePtr->tokenPtr); if (numWords != 3) { goto emitComplexLindex; |
︙ | ︙ | |||
1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 | int i; DefineLineInformation; /* TIP #280 */ /* * Check argument count. */ if (parsePtr->numWords < 3) { /* * Fail at run time, not in compilation. */ return TCL_ERROR; } | > | 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 | int i; DefineLineInformation; /* TIP #280 */ /* * Check argument count. */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { /* * Fail at run time, not in compilation. */ return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
987 988 989 990 991 992 993 | * semantics right, or when we know for sure that it is an error but need * the error to happen at the right time). * * Side effects: * Instructions are added to envPtr to execute the "switch" command at * runtime. * | < < < | 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 | * semantics right, or when we know for sure that it is an error but need * the error to happen at the right time). * * Side effects: * Instructions are added to envPtr to execute the "switch" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileSwitchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command |
︙ | ︙ | |||
2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 | CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int isScalar, localIndex, numWords, flags, i; Tcl_Obj *leadingWord; DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords-1; flags = 1; varTokenPtr = TokenAfter(parsePtr->tokenPtr); leadingWord = Tcl_NewObj(); if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) { int len; const char *bytes = Tcl_GetStringFromObj(leadingWord, &len); | > | 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 | CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int isScalar, localIndex, numWords, flags, i; Tcl_Obj *leadingWord; DefineLineInformation; /* TIP #280 */ /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords-1; flags = 1; varTokenPtr = TokenAfter(parsePtr->tokenPtr); leadingWord = Tcl_NewObj(); if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) { int len; const char *bytes = Tcl_GetStringFromObj(leadingWord, &len); |
︙ | ︙ | |||
3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 | int instruction, CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ int words; for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } if (parsePtr->numWords <= 2) { PushLiteral(envPtr, identity, -1); words++; | > | 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 | int instruction, CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; 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); } if (parsePtr->numWords <= 2) { PushLiteral(envPtr, identity, -1); words++; |
︙ | ︙ | |||
3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 | Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords < 3) { PUSH("1"); } else if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); | > | 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 | Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { PUSH("1"); } else if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); |
︙ | ︙ | |||
3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 | * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ int words; if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ return TCL_ERROR; } | > | 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 | * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ int words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ return TCL_ERROR; } |
︙ | ︙ | |||
3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 | * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ int words; if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ return TCL_ERROR; } | > | 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 | * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ int words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
12 13 14 15 16 17 18 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include <assert.h> | < < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include <assert.h> /* * Table of all AuxData types. */ static Tcl_HashTable auxDataTypeTable; static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */ |
︙ | ︙ | |||
560 561 562 563 564 565 566 | Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, int cmdNumber, int numSrcBytes, int numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset); | < < < < | 558 559 560 561 562 563 564 565 566 567 568 569 570 571 | Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, int cmdNumber, int numSrcBytes, int numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); static int IsCompactibleCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); |
︙ | ︙ | |||
1668 1669 1670 1671 1672 1673 1674 | if (valuePtr != NULL) { Tcl_AppendObjToObj(valuePtr, tempPtr); Tcl_DecrRefCount(tempPtr); } return 1; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 | if (valuePtr != NULL) { Tcl_AppendObjToObj(valuePtr, tempPtr); Tcl_DecrRefCount(tempPtr); } return 1; } /* *---------------------------------------------------------------------- * * TclCompileScript -- * * Compile a Tcl script in a string. * * Results: * The return value is TCL_OK on a successful compilation and TCL_ERROR * on failure. If TCL_ERROR is returned, then the interpreter's result * contains an error message. * * Side effects: * Adds instructions to envPtr to evaluate the script at runtime. * *---------------------------------------------------------------------- */ static int ExpandRequested( Tcl_Token *tokenPtr, int numWords) { /* Determine whether any words of the command require expansion */ while (numWords--) { |
︙ | ︙ | |||
2067 2068 2069 2070 2071 2072 2073 | ckfree(eclPtr->loc[wlineat].line); ckfree(eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; return cmdIdx; } | < < | 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 | ckfree(eclPtr->loc[wlineat].line); ckfree(eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; return cmdIdx; } void TclCompileScript( Tcl_Interp *interp, /* Used for error and status reporting. Also * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last * command this routine compiles into bytecode. * Initial value of -1 indicates this routine * has not yet generated any bytecode. */ const char *p = script; /* Where we are in our compile. */ if (envPtr->iPtr == NULL) { |
︙ | ︙ | |||
2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 | TclCompileSyntaxError(interp, envPtr); return; } #ifdef TCL_COMPILE_DEBUG /* * If tracing, print a line for each top level command compiled. */ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { int commandLength = parse.term - parse.commandStart; fprintf(stdout, " Compiling: "); TclPrintSource(stdout, parse.commandStart, TclMin(commandLength, 55)); | > | 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 | TclCompileSyntaxError(interp, envPtr); return; } #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)) { int commandLength = parse.term - parse.commandStart; fprintf(stdout, " Compiling: "); TclPrintSource(stdout, parse.commandStart, TclMin(commandLength, 55)); |
︙ | ︙ | |||
2194 2195 2196 2197 2198 2199 2200 | * so that the result of the last command becomes the result of * the script. The code here removes that trailing INST_POP. */ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; envPtr->currStackDepth++; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 | * so that the result of the last command becomes the result of * the script. The code here removes that trailing INST_POP. */ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; envPtr->currStackDepth++; } } /* *---------------------------------------------------------------------- * * TclCompileTokens -- * |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 | /* *---------------------------------------------------------------- * Macros and flag values used by Tcl bytecode compilation and execution * modules inside the Tcl core but not used outside. *---------------------------------------------------------------- */ #define LITERAL_ON_HEAP 0x01 #define LITERAL_CMD_NAME 0x02 /* * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to * cast away constness, and it is cleanest to do that here, all in one place. * | > > > > > > > > > | 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 | /* *---------------------------------------------------------------- * Macros and flag values used by Tcl bytecode compilation and execution * modules inside the Tcl core but not used outside. *---------------------------------------------------------------- */ /* * 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 /* * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to * cast away constness, and it is cleanest to do that here, all in one place. * |
︙ | ︙ |
Changes to generic/tclEnsemble.c.
︙ | ︙ | |||
3201 3202 3203 3204 3205 3206 3207 | 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. */ { | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 | 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. */ { Tcl_Obj *objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr, parsePtr->numWords, envPtr); Tcl_DecrRefCount(objPtr); return TCL_OK; } int TclCompileBasic0ArgCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 | TclStackFree(interp, parsePtr); return "$"; } code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1, NULL, NULL); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; } objPtr = Tcl_GetObjResult(interp); /* | > | 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 | TclStackFree(interp, parsePtr); return "$"; } code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1, NULL, NULL); Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; } objPtr = Tcl_GetObjResult(interp); /* |
︙ | ︙ |
Changes to generic/tclUtf.c.
︙ | ︙ | |||
1554 1555 1556 1557 1558 1559 1560 | * standard C function, otherwise consult the Unicode table. */ if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) { return TclIsSpaceProc((char) ch); } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060 | | | 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 | * standard C function, otherwise consult the Unicode table. */ if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) { 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 == 0x202f || (Tcl_UniChar) ch == 0xfeff) { return 1; } else { return ((SPACE_BITS >> GetCategory(ch)) & 1); } } /* |
︙ | ︙ |
Changes to tests/parse.test.
︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | testConstraint testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] testConstraint testparsevarname [llength [info commands testparsevarname]] testConstraint testparsevar [llength [info commands testparsevar]] testConstraint testasync [llength [info commands testasync]] testConstraint testcmdtrace [llength [info commands testcmdtrace]] testConstraint testevent [llength [info commands testevent]] test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} | > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | testConstraint testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] testConstraint testparsevarname [llength [info commands testparsevarname]] 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 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} |
︙ | ︙ | |||
674 675 676 677 678 679 680 681 682 683 684 685 686 687 | unset -nocomplain abc list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} 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-14.1 {Tcl_ParseBraces procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} | > > > > > > > > > > > > > > > > > > > > | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 | unset -nocomplain abc list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} 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 } {- foo 1 simple foo 1 text foo 0 {}} test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} |
︙ | ︙ |
Changes to tests/reg.test.
︙ | ︙ | |||
1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 | ([0-7]) # MinPriority ([[:blank:]]+) # Pad (PASS|TRUE|FAIL|FALSE) # ExtdSrvcsEnabled ([[:blank:]]+) # Pad (.*) # ConditionalFields }] 0 } 68 # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl | > > > | 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 | ([0-7]) # MinPriority ([[:blank:]]+) # Pad (PASS|TRUE|FAIL|FALSE) # ExtdSrvcsEnabled ([[:blank:]]+) # Pad (.*) # 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:[email protected] 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 [email protected] 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 return # Local Variables: # mode: tcl |
︙ | ︙ |
Changes to tests/regexp.test.
︙ | ︙ | |||
872 873 874 875 876 877 878 879 880 881 882 883 884 885 | append e [format %c [incr cp]] } } -body { regexp -about $e } -cleanup { unset -nocomplain e cp } -returnCodes error -match glob -result {*too many colors*} test regexp-23.1 {regexp -all and -line} { set string "" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^$} $string] \ [regexp -all -inline -indices -line -- {$} $string] | > > > > | 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 | append e [format %c [incr cp]] } } -body { regexp -about $e } -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 "" list \ [regexp -all -inline -indices -line -- {^} $string] \ [regexp -all -inline -indices -line -- {^$} $string] \ [regexp -all -inline -indices -line -- {$} $string] |
︙ | ︙ |
Changes to tests/subst.test.
︙ | ︙ | |||
289 290 291 292 293 294 295 296 297 298 299 300 301 302 | } } slave eval [list source $script] interp delete slave } -cleanup { removeFile subst13.tcl } # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl | > > > > | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 | } } slave eval [list source $script] interp delete slave } -cleanup { removeFile subst13.tcl } test subst-13.2 {Test for segfault} -body { subst {[} } -returnCodes error -result * -match glob # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl |
︙ | ︙ |
Added tests/unixForkEvent.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 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 |
Changes to unix/Makefile.in.
︙ | ︙ | |||
331 332 333 334 335 336 337 | bn_mp_shrink.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.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 | | > > > > > | 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 | bn_mp_shrink.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.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} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ tclUnixTime.o tclUnixInit.o tclUnixThrd.o \ tclUnixCompat.o 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 \ Zinffast.o Zinflate.o Zinftrees.o Ztrees.o Zuncompr.o Zzutil.o TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ |
︙ | ︙ | |||
571 572 573 574 575 576 577 578 579 580 581 582 583 584 | $(UNIX_DIR)/tclLoadShl.c MAC_OSX_SRCS = \ $(MAC_OSX_DIR)/tclMacOSXBundle.c \ $(MAC_OSX_DIR)/tclMacOSXFCmd.c \ $(MAC_OSX_DIR)/tclMacOSXNotify.c DTRACE_HDR = tclDTrace.h DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d ZLIB_SRCS = \ $(ZLIB_DIR)/adler32.c \ $(ZLIB_DIR)/compress.c \ | > > > | 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | $(UNIX_DIR)/tclLoadShl.c MAC_OSX_SRCS = \ $(MAC_OSX_DIR)/tclMacOSXBundle.c \ $(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 ZLIB_SRCS = \ $(ZLIB_DIR)/adler32.c \ $(ZLIB_DIR)/compress.c \ |
︙ | ︙ |
Changes to unix/configure.
︙ | ︙ | |||
4817 4818 4819 4820 4821 4822 4823 | fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? | > | | 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 | fi fi fi # Does the pthread-implementation provide # '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 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 |
︙ | ︙ | |||
4944 4945 4946 4947 4948 4949 4950 | else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 | else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ |
︙ | ︙ | |||
7166 7167 7168 7169 7170 7171 7172 | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" | | > > | 7065 7066 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,[email protected]' echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 |
︙ | ︙ |
Changes to unix/configure.in.
︙ | ︙ | |||
117 118 119 120 121 122 123 | fi #------------------------------------------------------------------------ # Threads support #------------------------------------------------------------------------ SC_ENABLE_THREADS | < | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | fi #------------------------------------------------------------------------ # Threads support #------------------------------------------------------------------------ SC_ENABLE_THREADS #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ SC_TCL_CFG_ENCODING |
︙ | ︙ |
Changes to unix/tcl.m4.
︙ | ︙ | |||
672 673 674 675 676 677 678 | fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? | | | 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 | fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork) else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with threads]) if test "${TCL_THREADS}" = 1; then AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) |
︙ | ︙ | |||
1220 1221 1222 1223 1224 1225 1226 | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" | | > > | 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*|MINGW32*) SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$[@].a' AC_CACHE_CHECK(for Cygwin version of gcc, |
︙ | ︙ |
Changes to unix/tclUnixNotfy.c.
︙ | ︙ | |||
115 116 117 118 119 120 121 122 123 124 125 126 127 128 | * notifiers. * * You must hold the notifierMutex lock before accessing this variable. */ static int notifierCount = 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. * * You must hold the notifierMutex lock before accessing this list. */ | > > > > > > > > > | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 | * notifiers. * * You must hold the notifierMutex lock before accessing this variable. */ 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. * * You must hold the notifierMutex lock before accessing this list. */ |
︙ | ︙ | |||
181 182 183 184 185 186 187 | /* * Static routines defined in this file. */ #ifdef TCL_THREADS static void NotifierThreadProc(ClientData clientData); | > > > > > > | | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | /* * Static routines defined in this file. */ #ifdef TCL_THREADS static void NotifierThreadProc(ClientData clientData); #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); /* * Import of Windows API when building threaded with Cygwin. */ #if defined(TCL_THREADS) && defined(__CYGWIN__) |
︙ | ︙ | |||
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 | tsdPtr->eventReady = 0; /* * Start the Notifier thread if necessary. */ Tcl_MutexLock(¬ifierMutex); if (notifierCount == 0) { if (TclpThreadCreate(¬ifierThread, NotifierThreadProc, NULL, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) { Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread"); } } notifierCount++; /* * Wait for the notifier pipe to be created. */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 | tsdPtr->eventReady = 0; /* * Start the Notifier thread if necessary. */ Tcl_MutexLock(¬ifierMutex); #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(¬ifierThread, NotifierThreadProc, NULL, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) { Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread"); } processIDInitialized = getpid(); } notifierCount++; /* * Wait for the notifier pipe to be created. */ |
︙ | ︙ | |||
1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 | Tcl_MutexLock(¬ifierMutex); triggerPipe = -1; Tcl_ConditionNotify(¬ifierCV); Tcl_MutexUnlock(¬ifierMutex); TclpThreadExit(0); } #endif /* TCL_THREADS */ #endif /* !HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 | Tcl_MutexLock(¬ifierMutex); triggerPipe = -1; Tcl_ConditionNotify(¬ifierCV); Tcl_MutexUnlock(¬ifierMutex); 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 */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to unix/tclUnixThrd.c.
︙ | ︙ | |||
11 12 13 14 15 16 17 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef TCL_THREADS | < < < < < < | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef TCL_THREADS /* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the * ability to statically initialize the mutex. */ static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER; |
︙ | ︙ |