Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | robust-async-connect-tests |
Files: | files | file ages | folders |
SHA1: |
8faac4e42d93c2533a8baca590586257 |
User & Date: | jan.nijtmans 2014-07-31 08:39:50 |
Context
2017-04-10
| ||
12:39 | Merge Harald's "robust-async-connect-tests" branch. Thanks! check-in: 9f162eb401 user: jan.nijtmans tags: trunk | |
2014-07-31
| ||
08:39 | merge trunk Closed-Leaf check-in: 8faac4e42d user: jan.nijtmans tags: robust-async-connect-tests | |
2014-07-30
| ||
16:41 | [3757cdf808] More clock refactoring with spooky impact on [string match] performance. check-in: db3153c306 user: dgp tags: trunk | |
2014-07-18
| ||
10:00 | Make sure the "sockettest" command is available even when running socket.test individually. check-in: 513dd86a37 user: jan.nijtmans tags: robust-async-connect-tests | |
Changes
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
406 407 408 409 410 411 412 413 414 415 416 417 418 419 | {"land", ASSEM_1BYTE, INST_LAND, 2, 1}, {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8 | INST_LAPPEND_SCALAR4), 1, 1}, {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8 | INST_LAPPEND_ARRAY4),2, 1}, {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1}, {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1}, {"le", ASSEM_1BYTE, INST_LE, 2, 1}, {"lindexMulti", ASSEM_LINDEX_MULTI, INST_LIST_INDEX_MULTI, INT_MIN,1}, {"list", ASSEM_LIST, INST_LIST, INT_MIN,1}, {"listConcat", ASSEM_1BYTE, INST_LIST_CONCAT, 2, 1}, {"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1}, | > > > > | 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 | {"land", ASSEM_1BYTE, INST_LAND, 2, 1}, {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8 | INST_LAPPEND_SCALAR4), 1, 1}, {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8 | INST_LAPPEND_ARRAY4),2, 1}, {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1}, {"lappendList", ASSEM_LVT4, INST_LAPPEND_LIST, 1, 1}, {"lappendListArray",ASSEM_LVT4, INST_LAPPEND_LIST_ARRAY,2, 1}, {"lappendListArrayStk", ASSEM_1BYTE,INST_LAPPEND_LIST_ARRAY_STK, 3, 1}, {"lappendListStk", ASSEM_1BYTE, INST_LAPPEND_LIST_STK, 2, 1}, {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1}, {"le", ASSEM_1BYTE, INST_LE, 2, 1}, {"lindexMulti", ASSEM_LINDEX_MULTI, INST_LIST_INDEX_MULTI, INT_MIN,1}, {"list", ASSEM_LIST, INST_LIST, INT_MIN,1}, {"listConcat", ASSEM_1BYTE, INST_LIST_CONCAT, 2, 1}, {"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1}, |
︙ | ︙ |
Changes to generic/tclClock.c.
︙ | ︙ | |||
516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 | * Results: * Result is either TCL_OK, with the interpreter result being the * dictionary augmented with a 'julianDay' key, or TCL_ERROR, * with the result being an error message. * *---------------------------------------------------------------------- */ static int ClockGetjuliandayfromerayearmonthdayObjCmd( ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; ClockClientData *data = clientData; Tcl_Obj *const *literals = data->literals; | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < | < | | < < < | < | | < | < < | 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 | * Results: * Result is either TCL_OK, with the interpreter result being the * dictionary augmented with a 'julianDay' key, or TCL_ERROR, * with the result being an error message. * *---------------------------------------------------------------------- */ static int FetchEraField( Tcl_Interp *interp, Tcl_Obj *dict, Tcl_Obj *key, int *storePtr) { Tcl_Obj *value = NULL; if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) { return TCL_ERROR; } if (value == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "expected key(s) not found in dictionary", -1)); return TCL_ERROR; } return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr); } static int FetchIntField( Tcl_Interp *interp, Tcl_Obj *dict, Tcl_Obj *key, int *storePtr) { Tcl_Obj *value = NULL; if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) { return TCL_ERROR; } if (value == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "expected key(s) not found in dictionary", -1)); return TCL_ERROR; } return TclGetIntFromObj(interp, value, storePtr); } static int ClockGetjuliandayfromerayearmonthdayObjCmd( ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; ClockClientData *data = clientData; Tcl_Obj *const *literals = data->literals; int changeover; int copied = 0; int status; int era = 0; /* * Check params. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); return TCL_ERROR; } dict = objv[1]; if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year) != TCL_OK || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month) != TCL_OK || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH], &fields.dayOfMonth) != TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } fields.era = era; /* * Get Julian day. */ |
︙ | ︙ | |||
621 622 623 624 625 626 627 | int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; ClockClientData *data = clientData; Tcl_Obj *const *literals = data->literals; | < | < < < | < | | < | | < | < < | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 | int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; ClockClientData *data = clientData; Tcl_Obj *const *literals = data->literals; int changeover; int copied = 0; int status; int era = 0; /* * Check params. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); return TCL_ERROR; } dict = objv[1]; if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR], &fields.iso8601Year) != TCL_OK || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK], &fields.iso8601Week) != TCL_OK || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK], &fields.dayOfWeek) != TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } fields.era = era; /* * Get Julian day. */ |
︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
︙ | ︙ | |||
864 865 866 867 868 869 870 | 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_Token *varTokenPtr, *valueTokenPtr; | | < < < < < < < < < < < < < > | 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 | 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_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; } if (numWords != 3 || envPtr->procPtr == NULL) { goto lappendMultiple; } /* * Decide if we can use a frame slot for the var/array name or if we * need to emit code to compute and push the name at runtime. We use a * frame slot (entry in the array of local vars) if we are compiling a |
︙ | ︙ | |||
939 940 941 942 943 944 945 | Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr); } } return TCL_OK; lappendMultiple: | < < < < < < < < | < < < < < < < < < | > | | > | > > | < | < < > | | > | 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 | Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr); } } return TCL_OK; lappendMultiple: varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, &localIndex, &isScalar, 1); valueTokenPtr = TokenAfter(varTokenPtr); for (i = 2 ; i < numWords ; i++) { CompileWord(envPtr, valueTokenPtr, interp, i); valueTokenPtr = TokenAfter(valueTokenPtr); } TclEmitInstInt4( INST_LIST, numWords-2, envPtr); if (isScalar) { if (localIndex < 0) { TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr); } else { TclEmitInstInt4(INST_LAPPEND_LIST, localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode( INST_LAPPEND_LIST_ARRAY_STK, envPtr); } else { TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLassignCmd -- |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
646 647 648 649 650 651 652 653 654 655 656 657 658 659 | * Stack: ... value => ... value isStrictBool */ {"strclass", 2, 0, 1, {OPERAND_SCLS1}}, /* See if all the characters of the given string are a member of the * specified (by opnd) character class. Note that an empty string will * satisfy the class check (standard definition of "all"). * Stack: ... stringValue => ... boolean */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; /* * Prototypes for procedures defined later in this file: */ | > > > > > > > > > > > > > | 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 | * Stack: ... value => ... value isStrictBool */ {"strclass", 2, 0, 1, {OPERAND_SCLS1}}, /* See if all the characters of the given string are a member of the * specified (by opnd) character class. Note that an empty string will * satisfy the class check (standard definition of "all"). * Stack: ... stringValue => ... boolean */ {"lappendList", 5, 0, 1, {OPERAND_LVT4}}, /* Lappend list to scalar variable at op4 in frame. * Stack: ... list => ... listVarContents */ {"lappendListArray", 5, -1, 1, {OPERAND_LVT4}}, /* Lappend list to array element; array at op4. * Stack: ... elem list => ... listVarContents */ {"lappendListArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Lappend list to array element. * Stack: ... arrayName elem list => ... listVarContents */ {"lappendListStk", 1, -1, 0, {OPERAND_NONE}}, /* Lappend list to general variable. * Stack: ... varName list => ... listVarContents */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; /* * Prototypes for procedures defined later in this file: */ |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
795 796 797 798 799 800 801 802 | #define INST_YIELD_TO_INVOKE 181 #define INST_NUM_TYPE 182 #define INST_TRY_CVT_TO_BOOLEAN 183 #define INST_STR_CLASS 184 /* The last opcode */ | > > > > > | | 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 | #define INST_YIELD_TO_INVOKE 181 #define INST_NUM_TYPE 182 #define INST_TRY_CVT_TO_BOOLEAN 183 #define INST_STR_CLASS 184 #define INST_LAPPEND_LIST 185 #define INST_LAPPEND_LIST_ARRAY 186 #define INST_LAPPEND_LIST_ARRAY_STK 187 #define INST_LAPPEND_LIST_STK 188 /* The last opcode */ #define LAST_INST_OPCODE 188 /* * Table describing the Tcl bytecode instructions: their name (for displaying * code), total number of code bytes required (including operand bytes), and a * description of the type of each operand. These operand types include signed * and unsigned integers of length one and four bytes. The unsigned integers * are used for indexes or for, e.g., the count of objects to push in a "push" |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
3343 3344 3345 3346 3347 3348 3349 | * * WARNING: more 'goto' here than your doctor recommended! The different * instructions set the value of some variables and then jump to somme * common execution code. */ { | | | 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 | * * WARNING: more 'goto' here than your doctor recommended! The different * instructions set the value of some variables and then jump to somme * common execution code. */ { int storeFlags, len; case INST_STORE_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doStoreArrayDirect; case INST_STORE_ARRAY1: |
︙ | ︙ | |||
3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 | goto gotError; } #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { NEXT_INST_V((pcAdjustment+1), cleanup, 0); } #endif TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); } /* * End of INST_STORE and related instructions. * ----------------------------------------------------------------- | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 | goto gotError; } #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { NEXT_INST_V((pcAdjustment+1), cleanup, 0); } #endif TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); case INST_LAPPEND_LIST: opnd = TclGetUInt4AtPtr(pc+1); valuePtr = OBJ_AT_TOS; varPtr = LOCAL(opnd); cleanup = 1; pcAdjustment = 5; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (TclIsVarDirectReadable(varPtr) && TclIsVarDirectWritable(varPtr)) { goto lappendListDirect; } arrayPtr = NULL; part1Ptr = part2Ptr = NULL; goto lappendListPtr; case INST_LAPPEND_LIST_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); valuePtr = OBJ_AT_TOS; part1Ptr = NULL; part2Ptr = OBJ_UNDER_TOS; arrayPtr = LOCAL(opnd); cleanup = 2; pcAdjustment = 5; while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%u \"%.30s\" \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr) && !WriteTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectReadable(varPtr) && TclIsVarDirectWritable(varPtr)) { goto lappendListDirect; } } varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd); if (varPtr == NULL) { TRACE_ERROR(interp); goto gotError; } goto lappendListPtr; case INST_LAPPEND_LIST_ARRAY_STK: pcAdjustment = 1; cleanup = 3; valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; /* element name */ part1Ptr = OBJ_AT_DEPTH(2); /* array name */ TRACE(("\"%.30s(%.30s)\" \"%.30s\" => ", O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); goto lappendList; case INST_LAPPEND_LIST_STK: pcAdjustment = 1; cleanup = 2; valuePtr = OBJ_AT_TOS; part2Ptr = NULL; part1Ptr = OBJ_UNDER_TOS; /* variable name */ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(valuePtr))); goto lappendList; lappendListDirect: objResultPtr = varPtr->value.objPtr; if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (Tcl_IsShared(objResultPtr)) { Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr); TclDecrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr = newValue; Tcl_IncrRefCount(newValue); } if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); lappendList: opnd = -1; if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } DECACHE_STACK_INFO(); varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr); CACHE_STACK_INFO(); if (!varPtr) { TRACE_ERROR(interp); goto gotError; } lappendListPtr: if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)++; } DECACHE_STACK_INFO(); objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)--; } if (arrayPtr && TclIsVarInHash(arrayPtr)) { VarHashRefCount(arrayPtr)--; } { int createdNewObj = 0; if (!objResultPtr) { objResultPtr = valuePtr; } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { if (Tcl_IsShared(objResultPtr)) { objResultPtr = Tcl_DuplicateObj(objResultPtr); createdNewObj = 1; } if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv) != TCL_OK) { goto errorInLappendListPtr; } } DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (!objResultPtr) { errorInLappendListPtr: if (createdNewObj) { TclDecrRefCount(objResultPtr); } TRACE_ERROR(interp); goto gotError; } } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); } /* * End of INST_STORE and related instructions. * ----------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
178 179 180 181 182 183 184 185 186 187 188 189 190 191 | static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr, int errorCode); static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, int errorCode, int flags); static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); static int CopyData(CopyState *csPtr, int mask); static void CopyEventProc(ClientData clientData, int mask); static void CreateScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask, Tcl_Obj *scriptPtr); static void DeleteChannelTable(ClientData clientData, Tcl_Interp *interp); static void DeleteScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask); | > > > > > > > > | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr, int errorCode); static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, int errorCode, int flags); static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); static int CopyData(CopyState *csPtr, int mask); static int MoveBytes(CopyState *csPtr); static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj); static void MBError(CopyState *csPtr, int mask, int errorCode); static int MBRead(CopyState *csPtr); static int MBWrite(CopyState *csPtr); static void MBEvent(ClientData clientData, int mask); static void CopyEventProc(ClientData clientData, int mask); static void CreateScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask, Tcl_Obj *scriptPtr); static void DeleteChannelTable(ClientData clientData, Tcl_Interp *interp); static void DeleteScriptRecord(Tcl_Interp *interp, Channel *chanPtr, int mask); |
︙ | ︙ | |||
1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 | statePtr->topChanPtr = chanPtr; statePtr->bottomChanPtr = chanPtr; chanPtr->downChanPtr = NULL; chanPtr->upChanPtr = NULL; chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; /* * TIP #219, Tcl Channel Reflection API */ statePtr->chanMsg = NULL; statePtr->unreportedMsg = NULL; | > | 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 | statePtr->topChanPtr = chanPtr; statePtr->bottomChanPtr = chanPtr; chanPtr->downChanPtr = NULL; chanPtr->upChanPtr = NULL; chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; chanPtr->refCount = 0; /* * TIP #219, Tcl Channel Reflection API */ statePtr->chanMsg = NULL; statePtr->unreportedMsg = NULL; |
︙ | ︙ | |||
1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 | chanPtr->state = statePtr; chanPtr->instanceData = instanceData; chanPtr->typePtr = typePtr; chanPtr->downChanPtr = prevChanPtr; chanPtr->upChanPtr = NULL; chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; /* * Place new block at the head of a possibly existing list of previously * stacked channels. */ prevChanPtr->upChanPtr = chanPtr; | > | 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 | chanPtr->state = statePtr; chanPtr->instanceData = instanceData; chanPtr->typePtr = typePtr; chanPtr->downChanPtr = prevChanPtr; chanPtr->upChanPtr = NULL; chanPtr->inQueueHead = NULL; chanPtr->inQueueTail = NULL; chanPtr->refCount = 0; /* * Place new block at the head of a possibly existing list of previously * stacked channels. */ prevChanPtr->upChanPtr = chanPtr; |
︙ | ︙ | |||
1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 | * time, mangling it. */ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT); return (Tcl_Channel) chanPtr; } /* *---------------------------------------------------------------------- * * Tcl_UnstackChannel -- * * Unstacks an entry in the hash table for a Tcl_Channel record. This is | > > > > > > > > > > > > > > > > > > > > > > > > > | 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 | * time, mangling it. */ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT); return (Tcl_Channel) chanPtr; } void TclChannelPreserve( Tcl_Channel chan) { ((Channel *)chan)->refCount++; } void TclChannelRelease( Tcl_Channel chan) { Channel *chanPtr = (Channel *) chan; if (chanPtr->refCount == 0) { Tcl_Panic("Channel released more than preserved"); } if (--chanPtr->refCount) { return; } if (chanPtr->typePtr == NULL) { ckfree(chanPtr); } } /* *---------------------------------------------------------------------- * * Tcl_UnstackChannel -- * * Unstacks an entry in the hash table for a Tcl_Channel record. This is |
︙ | ︙ | |||
2032 2033 2034 2035 2036 2037 2038 | /* * Close and free the channel driver state. */ result = ChanClose(chanPtr, interp); chanPtr->typePtr = NULL; | < < < < < | 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 | /* * Close and free the channel driver state. */ result = ChanClose(chanPtr, interp); chanPtr->typePtr = NULL; UpdateInterest(statePtr->topChanPtr); if (result != 0) { Tcl_SetErrno(result); /* * TIP #219, Tcl Channel Reflection API. |
︙ | ︙ | |||
2630 2631 2632 2633 2634 2635 2636 | } /* * Loop over the queued buffers and attempt to flush as much as possible * of the queued output to the channel. */ | | | 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 | } /* * Loop over the queued buffers and attempt to flush as much as possible * of the queued output to the channel. */ TclChannelPreserve((Tcl_Channel)chanPtr); while (statePtr->outQueueHead) { bufPtr = statePtr->outQueueHead; /* * Produce the output on the channel. */ |
︙ | ︙ | |||
2821 2822 2823 2824 2825 2826 2827 | ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE); goto done; } done: | | | 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 | ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE); goto done; } done: TclChannelRelease((Tcl_Channel)chanPtr); return errorCode; } /* *---------------------------------------------------------------------- * * CloseChannel -- |
︙ | ︙ | |||
2989 2990 2991 2992 2993 2994 2995 | statePtr->nextCSPtr = tsdPtr->firstCSPtr; tsdPtr->firstCSPtr = statePtr; statePtr->topChanPtr = downChanPtr; downChanPtr->upChanPtr = NULL; chanPtr->typePtr = NULL; | < < < | 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 | statePtr->nextCSPtr = tsdPtr->firstCSPtr; tsdPtr->firstCSPtr = statePtr; statePtr->topChanPtr = downChanPtr; downChanPtr->upChanPtr = NULL; chanPtr->typePtr = NULL; return Tcl_Close(interp, (Tcl_Channel) downChanPtr); } /* * There is only the TOP Channel, so we free the remaining pointers we * have and then ourselves. Since this is the last of the channels in the * stack, make sure to free the ChannelState structure associated with it. */ chanPtr->typePtr = NULL; Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); return errorCode; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
4379 4380 4381 4382 4383 4384 4385 | } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; | | | 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 | } /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); bufPtr = statePtr->inQueueHead; encoding = statePtr->encoding; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. |
︙ | ︙ | |||
4615 4616 4617 4618 4619 4620 4621 | gotEOL: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { | | | | 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 | gotEOL: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } bufPtr = gs.bufPtr; if (bufPtr == NULL) { Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL"); } statePtr->inputEncodingState = gs.state; |
︙ | ︙ | |||
4653 4654 4655 4656 4657 4658 4659 | restore: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { | | | | 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 | restore: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } bufPtr = statePtr->inQueueHead; if (bufPtr != NULL) { bufPtr->nextRemoved = oldRemoved; bufPtr = bufPtr->nextPtr; } |
︙ | ︙ | |||
4697 4698 4699 4700 4701 4702 4703 | done: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { | | | | | 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 | done: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copiedTotal; } /* *--------------------------------------------------------------------------- * * TclGetsObjBinary -- |
︙ | ︙ | |||
4748 4749 4750 4751 4752 4753 4754 | unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; | | | 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 | unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); bufPtr = statePtr->inQueueHead; /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ |
︙ | ︙ | |||
4953 4954 4955 4956 4957 4958 4959 | /* * Update the notifier state so we don't block while there is still data * in the buffers. */ done: UpdateInterest(chanPtr); | | | 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 | /* * Update the notifier state so we don't block while there is still data * in the buffers. */ done: UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copiedTotal; } /* *--------------------------------------------------------------------------- * * FreeBinaryEncoding -- |
︙ | ︙ | |||
5577 5578 5579 5580 5581 5582 5583 | /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; encoding = statePtr->encoding; factor = UTF_EXPANSION_FACTOR; | | | 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 | /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; encoding = statePtr->encoding; factor = UTF_EXPANSION_FACTOR; TclChannelPreserve((Tcl_Channel)chanPtr); binaryMode = (encoding == NULL) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); if (appendFlag == 0) { if (binaryMode) { |
︙ | ︙ | |||
5638 5639 5640 5641 5642 5643 5644 | } if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { break; } result = GetInput(chanPtr); if (chanPtr != statePtr->topChanPtr) { | | | | 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 | } if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { break; } result = GetInput(chanPtr); if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } if (result != 0) { if (!GotFlag(statePtr, CHANNEL_BLOCKED)) { copied = -1; } break; } |
︙ | ︙ | |||
5668 5669 5670 5671 5672 5673 5674 | } /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { | | | | | 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 | } /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); } /* * Update the notifier state so we don't block while there is still data * in the buffers. */ UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copied; } /* *--------------------------------------------------------------------------- * * ReadBytes -- |
︙ | ︙ | |||
8050 8051 8052 8053 8054 8055 8056 | /* * We are now above the topmost channel in a stack and have events left. * Now call the channel handlers as usual. * * Preserve the channel struct in case the script closes it. */ | | | 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 | /* * We are now above the topmost channel in a stack and have events left. * Now call the channel handlers as usual. * * Preserve the channel struct in case the script closes it. */ TclChannelPreserve((Tcl_Channel)channel); Tcl_Preserve(statePtr); /* * If we are flushing in the background, be sure to call FlushChannel for * writable events. Note that we have to discard the writable event so we * don't call any write handlers before the flush is complete. */ |
︙ | ︙ | |||
8100 8101 8102 8103 8104 8105 8106 | */ if (chanPtr->typePtr != NULL) { UpdateInterest(chanPtr); } Tcl_Release(statePtr); | | | 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 | */ if (chanPtr->typePtr != NULL) { UpdateInterest(chanPtr); } Tcl_Release(statePtr); TclChannelRelease(channel); tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
8582 8583 8584 8585 8586 8587 8588 | /* * We must preserve the interpreter so we can report errors on it later. * Note that we do not need to preserve the channel because that is done * by Tcl_NotifyChannel before calling channel handlers. */ Tcl_Preserve(interp); | | | | 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 8619 8620 8621 8622 8623 8624 8625 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 | /* * We must preserve the interpreter so we can report errors on it later. * Note that we do not need to preserve the channel because that is done * by Tcl_NotifyChannel before calling channel handlers. */ Tcl_Preserve(interp); TclChannelPreserve((Tcl_Channel)chanPtr); result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL); /* * On error, cause a background error and remove the channel handler and * the script record. * * NOTE: Must delete channel handler before causing the background error * because the background error may want to reinstall the handler. */ if (result != TCL_OK) { if (chanPtr->typePtr != NULL) { DeleteScriptRecord(interp, chanPtr, mask); } Tcl_BackgroundException(interp, result); } TclChannelRelease((Tcl_Channel)chanPtr); Tcl_Release(interp); } /* *---------------------------------------------------------------------- * * Tcl_FileEventObjCmd -- |
︙ | ︙ | |||
8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 | { Channel *inPtr = (Channel *) inChan; Channel *outPtr = (Channel *) outChan; ChannelState *inStatePtr, *outStatePtr; int readFlags, writeFlags; CopyState *csPtr; int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0; inStatePtr = inPtr->state; outStatePtr = outPtr->state; if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | > | 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 | { Channel *inPtr = (Channel *) inChan; Channel *outPtr = (Channel *) outChan; ChannelState *inStatePtr, *outStatePtr; int readFlags, writeFlags; CopyState *csPtr; int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0; int moveBytes; inStatePtr = inPtr->state; outStatePtr = outPtr->state; if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( |
︙ | ︙ | |||
8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 | /* * Make sure the output side is unbuffered. */ outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED) | CHANNEL_UNBUFFERED; /* * Allocate a new CopyState to maintain info about the current copy in * progress. This structure will be deallocated when the copy is * completed. */ | > > > > > > > > > > > | | > > > > | 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 8895 8896 8897 8898 8899 8900 8901 8902 | /* * Make sure the output side is unbuffered. */ outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED) | CHANNEL_UNBUFFERED; /* * Test for conditions where we know we can just move bytes from input * channel to output channel with no transformation or even examination * of the bytes themselves. */ moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF && inStatePtr->encoding == outStatePtr->encoding; /* * Allocate a new CopyState to maintain info about the current copy in * progress. This structure will be deallocated when the copy is * completed. */ csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; csPtr->readFlags = readFlags; csPtr->writeFlags = writeFlags; csPtr->toRead = toRead; csPtr->total = (Tcl_WideInt) 0; csPtr->interp = interp; if (cmdPtr) { Tcl_IncrRefCount(cmdPtr); } csPtr->cmdPtr = cmdPtr; inStatePtr->csPtrR = csPtr; outStatePtr->csPtrW = csPtr; if (moveBytes) { return MoveBytes(csPtr); } /* * Special handling of -size 0 async transfers, so that the -command is * still called asynchronously. */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { |
︙ | ︙ | |||
8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 | * Returns TCL_OK on success, else TCL_ERROR. * * Side effects: * Moves data between channels, may create channel handlers. * *---------------------------------------------------------------------- */ static int CopyData( CopyState *csPtr, /* State of copy operation. */ int mask) /* Current channel event flags. */ { Tcl_Interp *interp; | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 8923 8924 8925 8926 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981 8982 8983 8984 8985 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 9078 9079 9080 9081 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 9120 9121 9122 9123 9124 9125 9126 9127 9128 9129 9130 9131 9132 9133 9134 9135 9136 9137 9138 9139 9140 9141 9142 9143 9144 9145 9146 9147 9148 9149 9150 9151 9152 9153 9154 9155 | * Returns TCL_OK on success, else TCL_ERROR. * * Side effects: * Moves data between channels, may create channel handlers. * *---------------------------------------------------------------------- */ static void MBCallback( CopyState *csPtr, Tcl_Obj *errObj) { Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr); Tcl_WideInt total = csPtr->total; Tcl_Interp *interp = csPtr->interp; int code; Tcl_IncrRefCount(cmdPtr); StopCopy(csPtr); /* TODO: What if cmdPtr is not a list?! */ Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total)); if (errObj) { Tcl_ListObjAppendElement(NULL, cmdPtr, errObj); } Tcl_Preserve(interp); code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); } Tcl_Release(interp); TclDecrRefCount(cmdPtr); } static void MBError( CopyState *csPtr, int mask, int errorCode) { Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr; Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr; Tcl_Obj *errObj; Tcl_SetErrno(errorCode); errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s", (mask & TCL_READABLE) ? "read" : "writ", Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan), Tcl_PosixError(csPtr->interp)); if (csPtr->cmdPtr) { MBCallback(csPtr, errObj); } else { Tcl_SetObjResult(csPtr->interp, errObj); StopCopy(csPtr); } } static void MBEvent( ClientData clientData, int mask) { CopyState *csPtr = (CopyState *) clientData; Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr; Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr; ChannelState *inStatePtr = csPtr->readPtr->state; if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); switch (MBWrite(csPtr)) { case TCL_OK: MBCallback(csPtr, NULL); break; case TCL_CONTINUE: Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr); break; } } else if (mask & TCL_READABLE) { if (TCL_OK == MBRead(csPtr)) { /* When at least one full buffer is present, stop reading. */ if (IsBufferFull(inStatePtr->inQueueHead) || !Tcl_InputBlocked(inChan)) { Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); } /* Successful read -- set up to write the bytes we read */ Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr); } } } static int MBRead( CopyState *csPtr) { ChannelState *inStatePtr = csPtr->readPtr->state; ChannelBuffer *bufPtr = inStatePtr->inQueueHead; int code; if (bufPtr && BytesLeft(bufPtr) > 0) { return TCL_OK; } code = GetInput(inStatePtr->topChanPtr); if (code == 0) { return TCL_OK; } else { MBError(csPtr, TCL_READABLE, code); return TCL_ERROR; } } static int MBWrite( CopyState *csPtr) { ChannelState *inStatePtr = csPtr->readPtr->state; ChannelState *outStatePtr = csPtr->writePtr->state; ChannelBuffer *bufPtr = inStatePtr->inQueueHead; ChannelBuffer *tail = NULL; int code, inBytes = 0; /* Count up number of bytes waiting in the input queue */ while (bufPtr) { inBytes += BytesLeft(bufPtr); tail = bufPtr; if (csPtr->toRead != -1 && csPtr->toRead < inBytes) { /* Queue has enough bytes to complete the copy */ break; } bufPtr = bufPtr->nextPtr; } if (bufPtr) { /* Split the overflowing buffer in two */ int extra = inBytes - csPtr->toRead; bufPtr = AllocChannelBuffer(extra); tail->nextAdded -= extra; memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra); bufPtr->nextAdded += extra; bufPtr->nextPtr = tail->nextPtr; tail->nextPtr = NULL; inBytes = csPtr->toRead; } /* Update the byte counts */ if (csPtr->toRead != -1) { csPtr->toRead -= inBytes; } csPtr->total += inBytes; /* Move buffers from input to output channels */ if (outStatePtr->outQueueTail) { outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead; } else { outStatePtr->outQueueHead = inStatePtr->inQueueHead; } outStatePtr->outQueueTail = tail; inStatePtr->inQueueHead = bufPtr; if (bufPtr == NULL) { inStatePtr->inQueueTail = NULL; } code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0); if (code) { MBError(csPtr, TCL_WRITABLE, code); return TCL_ERROR; } if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) { return TCL_OK; } return TCL_CONTINUE; } static int MoveBytes( CopyState *csPtr) /* State of copy operation. */ { ChannelState *outStatePtr = csPtr->writePtr->state; ChannelBuffer *bufPtr = outStatePtr->curOutPtr; int errorCode; if (bufPtr && BytesLeft(bufPtr)) { /* If we start with unflushed bytes in the destination * channel, flush them out of the way first. */ errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0); if (errorCode != 0) { MBError(csPtr, TCL_WRITABLE, errorCode); return TCL_ERROR; } } if (csPtr->cmdPtr) { Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr; Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr); return TCL_OK; } while (1) { int code; if (TCL_ERROR == MBRead(csPtr)) { return TCL_ERROR; } code = MBWrite(csPtr); if (code == TCL_OK) { Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total)); StopCopy(csPtr); return TCL_OK; } if (code == TCL_ERROR) { return TCL_ERROR; } /* code == TCL_CONTINUE --> continue the loop */ } return TCL_OK; /* Silence compiler warnings */ } static int CopyData( CopyState *csPtr, /* State of copy operation. */ int mask) /* Current channel event flags. */ { Tcl_Interp *interp; |
︙ | ︙ | |||
9217 9218 9219 9220 9221 9222 9223 | char *dst, /* Where to store input read. */ int bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; char *p = dst; | | | 9479 9480 9481 9482 9483 9484 9485 9486 9487 9488 9489 9490 9491 9492 9493 | char *dst, /* Where to store input read. */ int bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; char *p = dst; TclChannelPreserve((Tcl_Channel)chanPtr); while (bytesToRead) { /* * Each pass through the loop is intended to process up to * one channel buffer. */ int bytesRead, bytesWritten; |
︙ | ︙ | |||
9256 9257 9258 9259 9260 9261 9262 | /* Further reads cannot do any more */ break; } if (code) { /* Read error */ UpdateInterest(chanPtr); | | | 9518 9519 9520 9521 9522 9523 9524 9525 9526 9527 9528 9529 9530 9531 9532 | /* Further reads cannot do any more */ break; } if (code) { /* Read error */ UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return -1; } assert (IsBufferFull(bufPtr)); } assert (bufPtr != NULL); |
︙ | ︙ | |||
9354 9355 9356 9357 9358 9359 9360 | break; } } if (bytesToRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } | | | 9616 9617 9618 9619 9620 9621 9622 9623 9624 9625 9626 9627 9628 9629 9630 | break; } } if (bytesToRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } TclChannelRelease((Tcl_Channel)chanPtr); return (int)(p - dst); } /* *---------------------------------------------------------------------- * * CopyEventProc -- |
︙ | ︙ | |||
9406 9407 9408 9409 9410 9411 9412 9413 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 | */ static void StopCopy( CopyState *csPtr) /* State for bg copy to stop . */ { ChannelState *inStatePtr, *outStatePtr; int nonBlocking; if (!csPtr) { return; } inStatePtr = csPtr->readPtr->state; outStatePtr = csPtr->writePtr->state; /* * Restore the old blocking mode and output buffering mode. */ | > > > > | 9668 9669 9670 9671 9672 9673 9674 9675 9676 9677 9678 9679 9680 9681 9682 9683 9684 9685 9686 9687 9688 9689 9690 9691 | */ static void StopCopy( CopyState *csPtr) /* State for bg copy to stop . */ { ChannelState *inStatePtr, *outStatePtr; Tcl_Channel inChan, outChan; int nonBlocking; if (!csPtr) { return; } inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; inStatePtr = csPtr->readPtr->state; outStatePtr = csPtr->writePtr->state; /* * Restore the old blocking mode and output buffering mode. */ |
︙ | ︙ | |||
9436 9437 9438 9439 9440 9441 9442 | } } ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); outStatePtr->flags |= csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); if (csPtr->cmdPtr) { | | < | < | > > | 9702 9703 9704 9705 9706 9707 9708 9709 9710 9711 9712 9713 9714 9715 9716 9717 9718 9719 9720 9721 | } } ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); outStatePtr->flags |= csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); if (csPtr->cmdPtr) { Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); if (inChan != outChan) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); TclDecrRefCount(csPtr->cmdPtr); } inStatePtr->csPtrR = NULL; outStatePtr->csPtrW = NULL; ckfree(csPtr); } |
︙ | ︙ |
Changes to generic/tclIO.h.
︙ | ︙ | |||
108 109 110 111 112 113 114 115 116 117 118 119 120 121 | /* * Intermediate buffers to hold pre-read data for consumption by a newly * stacked transformation. See 'Tcl_StackChannel'. */ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */ } Channel; /* * struct ChannelState: * * One of these structures is allocated for each open channel. It contains * data specific to the channel but which belongs to the generic part of the | > > | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | /* * Intermediate buffers to hold pre-read data for consumption by a newly * stacked transformation. See 'Tcl_StackChannel'. */ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */ int refCount; } Channel; /* * struct ChannelState: * * One of these structures is allocated for each open channel. It contains * data specific to the channel but which belongs to the generic part of the |
︙ | ︙ |
Changes to generic/tclIOCmd.c.
︙ | ︙ | |||
177 178 179 180 181 182 183 | if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for writing", TclGetString(chanObjPtr))); return TCL_ERROR; } | | | | | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for writing", TclGetString(chanObjPtr))); return TCL_ERROR; } TclChannelPreserve(chan); result = Tcl_WriteObj(chan, string); if (result < 0) { goto error; } if (newline != 0) { result = Tcl_WriteChars(chan, "\n", 1); if (result < 0) { goto error; } } TclChannelRelease(chan); return TCL_OK; /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. Fall back to the regular * message if nothing was found in the bypass. */ error: if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_FlushObjCmd -- |
︙ | ︙ | |||
251 252 253 254 255 256 257 | if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for writing", TclGetString(chanObjPtr))); return TCL_ERROR; } | | | | | 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | if (!(mode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for writing", TclGetString(chanObjPtr))); return TCL_ERROR; } TclChannelPreserve(chan); if (Tcl_Flush(chan) != TCL_OK) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error flushing \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); return TCL_ERROR; } TclChannelRelease(chan); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_GetsObjCmd -- |
︙ | ︙ | |||
318 319 320 321 322 323 324 | if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for reading", TclGetString(chanObjPtr))); return TCL_ERROR; } | | | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 | if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" wasn't opened for reading", TclGetString(chanObjPtr))); return TCL_ERROR; } TclChannelPreserve(chan); linePtr = Tcl_NewObj(); lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen < 0) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { Tcl_DecrRefCount(linePtr); /* |
︙ | ︙ | |||
353 354 355 356 357 358 359 | goto done; } Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen)); } else { Tcl_SetObjResult(interp, linePtr); } done: | | | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 | goto done; } Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen)); } else { Tcl_SetObjResult(interp, linePtr); } done: TclChannelRelease(chan); return code; } /* *---------------------------------------------------------------------- * * Tcl_ReadObjCmd -- |
︙ | ︙ | |||
461 462 463 464 465 466 467 | newline = 1; #endif } } resultPtr = Tcl_NewObj(); Tcl_IncrRefCount(resultPtr); | | | | | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 | newline = 1; #endif } } resultPtr = Tcl_NewObj(); Tcl_IncrRefCount(resultPtr); TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead < 0) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } /* * If requested, remove the last newline in the channel if at EOF. */ if ((charactersRead > 0) && (newline != 0)) { const char *result; int length; result = TclGetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { Tcl_SetObjLength(resultPtr, length - 1); } } Tcl_SetObjResult(interp, resultPtr); TclChannelRelease(chan); Tcl_DecrRefCount(resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
555 556 557 558 559 560 561 | if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } mode = modeArray[optionIndex]; } | | | | | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 | if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } mode = modeArray[optionIndex]; } TclChannelPreserve(chan); result = Tcl_Seek(chan, offset, mode); if (result == Tcl_LongAsWide(-1)) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error during seek on \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); } TclChannelRelease(chan); return TCL_ERROR; } TclChannelRelease(chan); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_TellObjCmd -- |
︙ | ︙ | |||
620 621 622 623 624 625 626 | * channel table of this interpreter. */ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } | | | | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 | * channel table of this interpreter. */ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } TclChannelPreserve(chan); newLoc = Tcl_Tell(chan); /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. */ code = TclChanCaughtErrorBypass(interp, chan); TclChannelRelease(chan); if (code) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(newLoc)); return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
432 433 434 435 436 437 438 439 440 441 442 443 444 445 | MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); static void DeleteReflectedChannelMap(ClientData clientData, Tcl_Interp *interp); static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); /* * Global constant strings (messages). ================== * These string are used directly as bypass errors, thus they have to be valid * Tcl lists where the last element is the message itself. Hence the * list-quoting to keep the words of the message together. See also [x]. */ | > | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 | MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); static void DeleteReflectedChannelMap(ClientData clientData, Tcl_Interp *interp); static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); static void MarkDead(ReflectedChannel *rcPtr); /* * Global constant strings (messages). ================== * These string are used directly as bypass errors, thus they have to be valid * Tcl lists where the last element is the message itself. Hence the * list-quoting to keep the words of the message together. See also [x]. */ |
︙ | ︙ | |||
653 654 655 656 657 658 659 | /* * Everything is fine now. */ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, mode); rcPtr->chan = chan; | | | 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 | /* * Everything is fine now. */ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, mode); rcPtr->chan = chan; TclChannelPreserve(chan); chanPtr = (Channel *) chan; if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* * Some of the nullable methods are not supported. We clone the * channel type, null the associated C functions, and use the result * as the actual channel type. |
︙ | ︙ | |||
1142 1143 1144 1145 1146 1147 1148 | */ Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { FreeReceivedError(&p); } | < | 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 | */ Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { FreeReceivedError(&p); } } #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { ckfree((char *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; |
︙ | ︙ | |||
1213 1214 1215 1216 1217 1218 1219 | #ifdef TCL_THREADS rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } | < | > | | | | < < < | 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 | #ifdef TCL_THREADS rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } } #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { ckfree((char *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return (result == TCL_OK) ? EOK : EINVAL; } /* *---------------------------------------------------------------------- * * ReflectInput -- |
︙ | ︙ | |||
2187 2188 2189 2190 2191 2192 2193 | static void FreeReflectedChannel( ReflectedChannel *rcPtr) { Channel *chanPtr = (Channel *) rcPtr->chan; | | > | > > | > > | > | 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 | static void FreeReflectedChannel( ReflectedChannel *rcPtr) { Channel *chanPtr = (Channel *) rcPtr->chan; TclChannelRelease((Tcl_Channel)chanPtr); if (rcPtr->name) { Tcl_DecrRefCount(rcPtr->name); } if (rcPtr->methods) { Tcl_DecrRefCount(rcPtr->methods); } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); } ckfree(rcPtr); } /* *---------------------------------------------------------------------- * * InvokeTclMethod -- |
︙ | ︙ | |||
2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 | * Side effects: * Deletes the hash table of channels. May close channels. May flush * output on closed channels. Removes any channeEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- */ static void DeleteReflectedChannelMap( ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedChannelMap *rcmPtr = clientData; | > > > > > > > > > > > > > > > > > > > > > > | 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 | * Side effects: * Deletes the hash table of channels. May close channels. May flush * output on closed channels. Removes any channeEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- */ static void MarkDead( ReflectedChannel *rcPtr) { if (rcPtr->dead) { return; } if (rcPtr->name) { Tcl_DecrRefCount(rcPtr->name); rcPtr->name = NULL; } if (rcPtr->methods) { Tcl_DecrRefCount(rcPtr->methods); rcPtr->methods = NULL; } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); rcPtr->cmd = NULL; } rcPtr->dead = 1; } static void DeleteReflectedChannelMap( ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedChannelMap *rcmPtr = clientData; |
︙ | ︙ | |||
2490 2491 2492 2493 2494 2495 2496 | for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { chan = Tcl_GetHashValue(hPtr); rcPtr = Tcl_GetChannelInstanceData(chan); | | | 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 | for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { chan = Tcl_GetHashValue(hPtr); rcPtr = Tcl_GetChannelInstanceData(chan); MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); ckfree(&rcmPtr->map); #ifdef TCL_THREADS /* |
︙ | ︙ | |||
2573 2574 2575 2576 2577 2578 2579 | /* * Ignore entries for other interpreters. */ continue; } | | | 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 | /* * Ignore entries for other interpreters. */ continue; } MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } #endif } #ifdef TCL_THREADS /* |
︙ | ︙ | |||
2720 2721 2722 2723 2724 2725 2726 | rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { Tcl_Channel chan = Tcl_GetHashValue(hPtr); ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan); | | | 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 | rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { Tcl_Channel chan = Tcl_GetHashValue(hPtr); ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan); MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } ckfree(rcmPtr); } static void ForwardOpToHandlerThread( |
︙ | ︙ | |||
2903 2904 2905 2906 2907 2908 2909 | */ case ForwardedClose: { /* * No parameters/results. */ | < < | 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 | */ case ForwardedClose: { /* * No parameters/results. */ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* * Freeing is done here, in the origin thread, callback command * objects belong to this thread. Deallocating them in a different |
︙ | ︙ | |||
2928 2929 2930 2931 2932 2933 2934 | Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); | | < < < < < < | 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 | Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); MarkDead(rcPtr); break; } case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); Tcl_IncrRefCount(toReadObj); |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 | MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, const char *value); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE int TclClearRootEnsemble(ClientData data[], Tcl_Interp *interp, int result); | > > | 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 | MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, const char *value); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE int TclClearRootEnsemble(ClientData data[], Tcl_Interp *interp, int result); |
︙ | ︙ |
Changes to generic/tclOO.c.
︙ | ︙ | |||
1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 | if (!IsRootClass(oPtr)) { FOREACH(instancePtr, clsPtr->instances) { if (instancePtr == NULL || IsRoot(instancePtr)) { continue; } if (!Deleted(instancePtr)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } DelRef(instancePtr); } } if (clsPtr->instances.list != NULL) { ckfree(clsPtr->instances.list); clsPtr->instances.list = NULL; | > > > > > > | 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 | if (!IsRootClass(oPtr)) { FOREACH(instancePtr, clsPtr->instances) { if (instancePtr == NULL || IsRoot(instancePtr)) { continue; } if (!Deleted(instancePtr)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); /* * Tcl_DeleteCommandFromToken() may have done to whole * job for us. Roll back and check again. */ i--; continue; } DelRef(instancePtr); } } if (clsPtr->instances.list != NULL) { ckfree(clsPtr->instances.list); clsPtr->instances.list = NULL; |
︙ | ︙ | |||
1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 | goto removeInstance; } } return; removeInstance: if (Deleted(clsPtr->thisPtr)) { clsPtr->instances.list[i] = NULL; } else { clsPtr->instances.num--; if (i < clsPtr->instances.num) { clsPtr->instances.list[i] = clsPtr->instances.list[clsPtr->instances.num]; } | > | 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 | goto removeInstance; } } return; removeInstance: if (Deleted(clsPtr->thisPtr)) { DelRef(clsPtr->instances.list[i]); clsPtr->instances.list[i] = NULL; } else { clsPtr->instances.num--; if (i < clsPtr->instances.num) { clsPtr->instances.list[i] = clsPtr->instances.list[clsPtr->instances.num]; } |
︙ | ︙ |
Changes to tests/all.tcl.
︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest package require Tcl 8.5 package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] runAllTests proc exit args {} | > > > | 11 12 13 14 15 16 17 18 19 20 21 22 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest package require Tcl 8.5 package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] if {[singleProcess]} { interp debug {} -frame 1 } runAllTests proc exit args {} |
Changes to tests/io.test.
︙ | ︙ | |||
7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 | after 2000 {set ::done timeout} fileevent $f1 readable {set ::done ok} vwait ::done set ch [read $f1 1] close $f1 list $::done $ch } {ok A} test io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 7661 7662 7663 7664 7665 7666 7667 7668 7669 7670 7671 7672 7673 7674 7675 7676 7677 7678 7679 7680 7681 | after 2000 {set ::done timeout} fileevent $f1 readable {set ::done ok} vwait ::done set ch [read $f1 1] close $f1 list $::done $ch } {ok A} test io-53.13 {TclCopyChannel: read error reporting} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { return {initialize finalize watch read} } finalize { return } watch {} read { error FAIL } } } set outFile [makeFile {} out] } -body { set in [chan create read [namespace which driver]] chan configure $in -translation binary set out [open $outFile wb] chan copy $in $out } -cleanup { catch {close $in} catch {close $out} removeFile out rename driver {} } -result {error reading "*": *} -returnCodes error -match glob test io-53.14 {TclCopyChannel: write error reporting} -setup { proc driver {cmd args} { variable buffer variable index set chan [lindex $args 0] switch -- $cmd { initialize { return {initialize finalize watch write} } finalize { return } watch {} write { error FAIL } } } set inFile [makeFile {aaa} in] } -body { set in [open $inFile rb] set out [chan create write [namespace which driver]] chan configure $out -translation binary chan copy $in $out } -cleanup { catch {close $in} catch {close $out} removeFile in rename driver {} } -result {error writing "*": *} -returnCodes error -match glob test io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as |
︙ | ︙ |
Changes to tests/ioCmd.test.
︙ | ︙ | |||
2744 2745 2746 2747 2748 2749 2750 2751 2752 | lappend ::res [lrange [info level 0] 1 end] LOG "-> [info level 0]" set ret {} switch -glob -- $op { init* {set ret {initialize finalize watch read}} watch { set l [lindex $args 0] if {[llength $l]} { set ::timer [after $::drive [list POST $ch]] | > < < | 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 | lappend ::res [lrange [info level 0] 1 end] LOG "-> [info level 0]" set ret {} switch -glob -- $op { init* {set ret {initialize finalize watch read}} watch { set l [lindex $args 0] catch {after cancel $::timer} if {[llength $l]} { set ::timer [after $::drive [list POST $ch]] } } finalize { catch { after cancel $::timer } after 500 {set ::forever now} } read { |
︙ | ︙ | |||
2810 2811 2812 2813 2814 2815 2816 | set done 0 while {!$done} { after $beat LOG THREAD-HEARTBEAT update } LOG THREAD-LOOP-DONE | | > > | 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 | set done 0 while {!$done} { after $beat LOG THREAD-HEARTBEAT update } LOG THREAD-LOOP-DONE #thread::exit # Thread exits cause leaks; Use clean thread shutdown set forever yourGirl } LOG MAIN_WAITING vwait forever LOG MAIN_DONE set res |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
254 255 256 257 258 259 260 261 262 263 264 265 266 267 | } -body { oo::define B constructor {} {A create test-oo-1.18} B create C } -cleanup { rename test-oo-1.18 {} A destroy } -result ::C test oo-1.19 {basic test of OO functionality: teardown order} -body { oo::object create o namespace delete [info object namespace o] o destroy # Crashes on error } -returnCodes error -result {invalid command name "o"} test oo-1.20 {basic test of OO functionality: my teardown post rename} -body { | > > > > > > > > > > > > > | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 | } -body { oo::define B constructor {} {A create test-oo-1.18} B create C } -cleanup { rename test-oo-1.18 {} A destroy } -result ::C test oo-1.18.1 {Bug 75b8433707: memory leak in oo-1.18} -setup { proc test-oo-1.18 {} return } -constraints memory -body { leaktest { oo::class create A oo::class create B {superclass A} oo::define B constructor {} {A create test-oo-1.18} B create C A destroy } } -cleanup { rename test-oo-1.18 {} } -result 0 test oo-1.19 {basic test of OO functionality: teardown order} -body { oo::object create o namespace delete [info object namespace o] o destroy # Crashes on error } -returnCodes error -result {invalid command name "o"} test oo-1.20 {basic test of OO functionality: my teardown post rename} -body { |
︙ | ︙ |
Changes to unix/tclUnixNotfy.c.
︙ | ︙ | |||
307 308 309 310 311 312 313 314 315 316 317 318 319 320 | #endif /* HAVE_PTHREAD_ATFORK */ /* * 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, | > | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | #endif /* HAVE_PTHREAD_ATFORK */ /* * 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()) { Tcl_ConditionFinalize(¬ifierCV); notifierCount = 0; processIDInitialized = 0; close(triggerPipe); triggerPipe = -1; } if (notifierCount == 0) { if (TclpThreadCreate(¬ifierThread, NotifierThreadProc, NULL, |
︙ | ︙ | |||
1371 1372 1373 1374 1375 1376 1377 | * *---------------------------------------------------------------------- */ static void AtForkChild(void) { | | < | 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 | * *---------------------------------------------------------------------- */ static void AtForkChild(void) { Tcl_MutexFinalize(¬ifierMutex); Tcl_InitNotifier(); } #endif /* HAVE_PTHREAD_ATFORK */ #endif /* TCL_THREADS */ #endif /* !HAVE_COREFOUNDATION */ |
︙ | ︙ |