Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | More generation of errorCodes ([interp], [lset], [load], [unload]). |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
d109deac44e0595585a6ca4419011c33 |
User & Date: | dkf 2011-04-02 17:22:01 |
Context
2011-04-02
| ||
22:07 | Replaced another couple of 'double' declarations with 'volatile double' to work around misrounding ... check-in: 147186904c user: kbk tags: trunk | |
17:22 | More generation of errorCodes ([interp], [lset], [load], [unload]). check-in: d109deac44 user: dkf tags: trunk | |
12:17 | More generation of errorCode information (default [bgerror] and [glob]). check-in: a2fcb8020d user: dkf tags: trunk | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 8 9 | 2011-04-02 Donal K. Fellows <[email protected]> * generic/tclEvent.c, generic/tclFileName.c: More generation of errorCode information (default [bgerror] and [glob]). 2011-04-01 Reinhard Max <[email protected]> * library/init.tcl: TIP#131 implementation. | > > > | 1 2 3 4 5 6 7 8 9 10 11 12 | 2011-04-02 Donal K. Fellows <[email protected]> * generic/tclInterp.c, generic/tclListObj.c, generic/tclLoad.c: More generation of errorCodes ([interp], [lset], [load], [unload]). * generic/tclEvent.c, generic/tclFileName.c: More generation of errorCode information (default [bgerror] and [glob]). 2011-04-01 Reinhard Max <[email protected]> * library/init.tcl: TIP#131 implementation. |
︙ | ︙ |
Changes to generic/tclInterp.c.
︙ | ︙ | |||
296 297 298 299 300 301 302 | int Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { if (tclPreInitScript != NULL) { if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { | | < > | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 | int Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { if (tclPreInitScript != NULL) { if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { return TCL_ERROR; } } /* * In order to find init.tcl during initialization, the following script * is invoked by Tcl_Init(). It looks in several different directories: * * $tcl_library - can specify a primary location, if set, no |
︙ | ︙ | |||
555 556 557 558 559 560 561 562 563 564 565 566 567 568 | int Tcl_InterpObjCmd( ClientData clientData, /* Unused. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int index; static const char *const options[] = { "alias", "aliases", "bgerror", "cancel", "create", "debug", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", "recursionlimit", | > | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 | int Tcl_InterpObjCmd( ClientData clientData, /* Unused. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *slaveInterp; int index; static const char *const options[] = { "alias", "aliases", "bgerror", "cancel", "create", "debug", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", "recursionlimit", |
︙ | ︙ | |||
584 585 586 587 588 589 590 | } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum option) index) { case OPT_ALIAS: { | | | 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 | } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum option) index) { case OPT_ALIAS: { Tcl_Interp *masterInterp; if (objc < 4) { aliasArgs: Tcl_WrongNumArgs(interp, 2, objv, "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
618 619 620 621 622 623 624 | } else { return AliasCreate(interp, slaveInterp, masterInterp, objv[3], objv[5], objc - 6, objv + 6); } } goto aliasArgs; } | | < < < | < < < < | 619 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 646 647 648 649 650 | } else { return AliasCreate(interp, slaveInterp, masterInterp, objv[3], objv[5], objc - 6, objv + 6); } } goto aliasArgs; } case OPT_ALIASES: slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } return AliasList(interp, slaveInterp); case OPT_BGERROR: if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3); case OPT_CANCEL: { int i, flags; Tcl_Obj *resultObjPtr; static const char *const cancelOptions[] = { "-unwind", "--", NULL }; enum option { OPT_UNWIND, OPT_LAST }; |
︙ | ︙ | |||
676 677 678 679 680 681 682 | break; case OPT_LAST: i++; goto endOfForLoop; } } | | < | | > > > < | | | | | | | | | | | < < < | 670 671 672 673 674 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 709 710 711 712 713 714 715 716 717 718 719 | break; case OPT_LAST: i++; goto endOfForLoop; } } endOfForLoop: if ((i + 2) < objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? ?--? ?path? ?result?"); return TCL_ERROR; } /* * Did they specify a slave interp to cancel the script in progress * in? If not, use the current interp. */ if (i < objc) { slaveInterp = GetInterp(interp, objv[i]); if (slaveInterp == NULL) { return TCL_ERROR; } i++; } else { slaveInterp = interp; } if (i < objc) { resultObjPtr = objv[i]; /* * Tcl_CancelEval removes this reference. */ Tcl_IncrRefCount(resultObjPtr); i++; } else { resultObjPtr = NULL; } return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags); } case OPT_CREATE: { int i, last, safe; Tcl_Obj *slavePtr; char buf[16 + TCL_INTEGER_SPACE]; static const char *const createOptions[] = { "-safe", "--", NULL |
︙ | ︙ | |||
783 784 785 786 787 788 789 | Tcl_DecrRefCount(slavePtr); } return TCL_ERROR; } Tcl_SetObjResult(interp, slavePtr); return TCL_OK; } | | < < < > < < > > | < < < | < < | < < < | < < < | < < < | < < < < | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 | Tcl_DecrRefCount(slavePtr); } return TCL_ERROR; } Tcl_SetObjResult(interp, slavePtr); return TCL_OK; } case OPT_DEBUG: /* TIP #378 */ /* * Currently only -frame supported, otherwise ?-option ?value?? */ if (objc < 3 || objc > 5) { Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3); case OPT_DELETE: { int i; InterpInfo *iiPtr; for (i = 2; i < objc; i++) { slaveInterp = GetInterp(interp, objv[i]); if (slaveInterp == NULL) { return TCL_ERROR; } else if (slaveInterp == interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot delete the current interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "DELETESELF", NULL); return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp, iiPtr->slave.interpCmd); } return TCL_OK; } case OPT_EVAL: if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveEval(interp, slaveInterp, objc - 3, objv + 3); case OPT_EXISTS: { int exists = 1; slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { if (objc > 3) { return TCL_ERROR; } Tcl_ResetResult(interp); exists = 0; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists)); return TCL_OK; } case OPT_EXPOSE: if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3); case OPT_HIDE: if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveHide(interp, slaveInterp, objc - 3, objv + 3); case OPT_HIDDEN: slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveHidden(interp, slaveInterp); case OPT_ISSAFE: slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp))); return TCL_OK; case OPT_INVOKEHID: { int i; const char *namespaceName; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST }; |
︙ | ︙ | |||
940 941 942 943 944 945 946 | if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc - i, objv + i); } case OPT_LIMIT: { | < | 912 913 914 915 916 917 918 919 920 921 922 923 924 925 | if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc - i, objv + i); } case OPT_LIMIT: { static const char *const limitTypes[] = { "commands", "time", NULL }; enum LimitTypes { LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME }; int limitType; |
︙ | ︙ | |||
969 970 971 972 973 974 975 | switch ((enum LimitTypes) limitType) { case LIMIT_TYPE_COMMANDS: return SlaveCommandLimitCmd(interp, slaveInterp, 4, objc,objv); case LIMIT_TYPE_TIME: return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv); } } | | < < < | < < < < | 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 | switch ((enum LimitTypes) limitType) { case LIMIT_TYPE_COMMANDS: return SlaveCommandLimitCmd(interp, slaveInterp, 4, objc,objv); case LIMIT_TYPE_TIME: return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv); } } case OPT_MARKTRUSTED: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveMarkTrusted(interp, slaveInterp); case OPT_RECLIMIT: if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3); case OPT_SLAVES: { InterpInfo *iiPtr; Tcl_Obj *resultPtr; Tcl_HashEntry *hPtr; Tcl_HashSearch hashSearch; char *string; slaveInterp = GetInterp2(interp, objc, objv); |
︙ | ︙ | |||
1020 1021 1022 1023 1024 1025 1026 | Tcl_NewStringObj(string, -1)); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } case OPT_TRANSFER: case OPT_SHARE: { | < | | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 | Tcl_NewStringObj(string, -1)); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } case OPT_TRANSFER: case OPT_SHARE: { Tcl_Interp *masterInterp; /* The master of the slave. */ Tcl_Channel chan; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath"); return TCL_ERROR; } masterInterp = GetInterp(interp, objv[2]); |
︙ | ︙ | |||
1056 1057 1058 1059 1060 1061 1062 | Tcl_TransferResult(masterInterp, TCL_OK, interp); return TCL_ERROR; } } return TCL_OK; } case OPT_TARGET: { | < | 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 | Tcl_TransferResult(masterInterp, TCL_OK, interp); return TCL_ERROR; } } return TCL_OK; } case OPT_TARGET: { InterpInfo *iiPtr; Tcl_HashEntry *hPtr; Alias *aliasPtr; const char *aliasName; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path alias"); |
︙ | ︙ | |||
1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 | } aliasPtr = Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "target interpreter for alias \"", aliasName, "\" in path \"", Tcl_GetString(objv[2]), "\" is not my descendant", NULL); return TCL_ERROR; } return TCL_OK; } } return TCL_OK; } | > > | 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 | } aliasPtr = Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "target interpreter for alias \"", aliasName, "\" in path \"", Tcl_GetString(objv[2]), "\" is not my descendant", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "TARGETSHROUDED", NULL); return TCL_ERROR; } return TCL_OK; } } return TCL_OK; } |
︙ | ︙ | |||
1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 | return TCL_OK; } aliasCmdPtr = (Command *) aliasCmd; if (aliasCmdPtr == cmdPtr) { Tcl_AppendResult(interp, "cannot define or rename alias \"", Tcl_GetCommandName(cmdInterp, cmd), "\": would create a loop", NULL); return TCL_ERROR; } /* * Otherwise, follow the chain one step further. See if the target * command is an alias - if so, follow the loop to its target command. * Otherwise we do not have a loop. | > > | 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 | return TCL_OK; } aliasCmdPtr = (Command *) aliasCmd; if (aliasCmdPtr == cmdPtr) { Tcl_AppendResult(interp, "cannot define or rename alias \"", Tcl_GetCommandName(cmdInterp, cmd), "\": would create a loop", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "ALIASLOOP", NULL); return TCL_ERROR; } /* * Otherwise, follow the chain one step further. See if the target * command is an alias - if so, follow the loop to its target command. * Otherwise we do not have a loop. |
︙ | ︙ | |||
2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 | if (objc) { int length; if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1", NULL); return TCL_ERROR; } TclSetBgErrorHandler(slaveInterp, objv[0]); } Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp)); return TCL_OK; } | > > | 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 | if (objc) { int length; if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BGERRORFORMAT", NULL); return TCL_ERROR; } TclSetBgErrorHandler(slaveInterp, objv[0]); } Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp)); return TCL_OK; } |
︙ | ︙ | |||
2724 2725 2726 2727 2728 2729 2730 | resultPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj("-frame", -1)); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); Tcl_SetObjResult(interp, resultPtr); } else { | | | > | | | > | 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 | resultPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj("-frame", -1)); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); Tcl_SetObjResult(interp, resultPtr); } else { if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option", 0, &debugType) != TCL_OK) { return TCL_ERROR; } if (debugType == DEBUG_TYPE_FRAME) { if (objc == 2) { /* set */ if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType) != TCL_OK) { return TCL_ERROR; } /* * Quietly ignore attempts to disable interp debugging. This * is a one-way switch as frame debug info is maintained in a * stack that must be consistent once turned on. */ if (debugType) { iPtr->flags |= INTERP_DEBUG_FRAME; } } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); } |
︙ | ︙ | |||
2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 | { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot expose commands", -1)); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) { Tcl_TransferResult(slaveInterp, TCL_ERROR, interp); | > > | 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 | { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot expose commands", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) { Tcl_TransferResult(slaveInterp, TCL_ERROR, interp); |
︙ | ︙ | |||
2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 | Interp *iPtr; int limit; if (objc) { if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "permission denied: " "safe interpreters cannot change recursion limit", NULL); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { return TCL_ERROR; } if (limit <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "recursion limit must be > 0", -1)); return TCL_ERROR; } Tcl_SetRecursionLimit(slaveInterp, limit); iPtr = (Interp *) slaveInterp; if (interp == slaveInterp && iPtr->numLevels > limit) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "falling back due to new recursion limit", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[0]); return TCL_OK; } else { limit = Tcl_SetRecursionLimit(slaveInterp, 0); Tcl_SetObjResult(interp, Tcl_NewIntObj(limit)); | > > > > > | 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 | Interp *iPtr; int limit; if (objc) { if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "permission denied: " "safe interpreters cannot change recursion limit", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { return TCL_ERROR; } if (limit <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "recursion limit must be > 0", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", NULL); return TCL_ERROR; } Tcl_SetRecursionLimit(slaveInterp, limit); iPtr = (Interp *) slaveInterp; if (interp == slaveInterp && iPtr->numLevels > limit) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "falling back due to new recursion limit", -1)); Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[0]); return TCL_OK; } else { limit = Tcl_SetRecursionLimit(slaveInterp, 0); Tcl_SetObjResult(interp, Tcl_NewIntObj(limit)); |
︙ | ︙ | |||
2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 | { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot hide commands", -1)); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) { Tcl_TransferResult(slaveInterp, TCL_ERROR, interp); return TCL_ERROR; | > > | 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 | { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot hide commands", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) { Tcl_TransferResult(slaveInterp, TCL_ERROR, interp); return TCL_ERROR; |
︙ | ︙ | |||
3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 | { int result; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not allowed to invoke hidden commands from safe interpreter", -1)); return TCL_ERROR; } Tcl_Preserve(slaveInterp); Tcl_AllowExceptions(slaveInterp); if (namespaceName == NULL) { | > > | 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 | { int result; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not allowed to invoke hidden commands from safe interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } Tcl_Preserve(slaveInterp); Tcl_AllowExceptions(slaveInterp); if (namespaceName == NULL) { |
︙ | ︙ | |||
3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 | Tcl_Interp *slaveInterp) /* The slave interpreter which will be marked * trusted. */ { if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot mark trusted", -1)); return TCL_ERROR; } ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP; return TCL_OK; } /* | > > | 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 | Tcl_Interp *slaveInterp) /* The slave interpreter which will be marked * trusted. */ { if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot mark trusted", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; } ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP; return TCL_OK; } /* |
︙ | ︙ | |||
3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 | Tcl_Preserve(interp); RunLimitHandlers(iPtr->limit.cmdHandlers, interp); if (iPtr->limit.cmdCount >= iPtr->cmdCount) { iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS; } else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "command count limit exceeded", NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); } if ((iPtr->limit.active & TCL_LIMIT_TIME) && | > | 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 | Tcl_Preserve(interp); RunLimitHandlers(iPtr->limit.cmdHandlers, interp); if (iPtr->limit.cmdCount >= iPtr->cmdCount) { iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS; } else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "command count limit exceeded", NULL); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); } if ((iPtr->limit.active & TCL_LIMIT_TIME) && |
︙ | ︙ | |||
3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 | if (iPtr->limit.time.sec > now.sec || (iPtr->limit.time.sec == now.sec && iPtr->limit.time.usec >= now.usec)) { iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "time limit exceeded", NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); } } | > | 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 | if (iPtr->limit.time.sec > now.sec || (iPtr->limit.time.sec == now.sec && iPtr->limit.time.usec >= now.usec)) { iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "time limit exceeded", NULL); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); } } |
︙ | ︙ | |||
4425 4426 4427 4428 4429 4430 4431 | Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp))); } break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { | | < | 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 | Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp))); } break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { int i, scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; for (i=consumedObjc ; i<objc ; i+=2) { |
︙ | ︙ | |||
4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 | granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { Tcl_AppendResult(interp, "granularity must be at " "least 1", NULL); return TCL_ERROR; } break; case OPT_VAL: limitObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &limitLen); if (limitLen == 0) { break; } if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) { return TCL_ERROR; } if (limit < 0) { Tcl_AppendResult(interp, "command limit value must be at " "least 0", NULL); return TCL_ERROR; } break; } } if (scriptObj != NULL) { SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, slaveInterp, | > > > > | 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 | granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { Tcl_AppendResult(interp, "granularity must be at " "least 1", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } break; case OPT_VAL: limitObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &limitLen); if (limitLen == 0) { break; } if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) { return TCL_ERROR; } if (limit < 0) { Tcl_AppendResult(interp, "command limit value must be at " "least 0", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } break; } } if (scriptObj != NULL) { SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, slaveInterp, |
︙ | ︙ | |||
4613 4614 4615 4616 4617 4618 4619 | Tcl_LimitGetTime(slaveInterp, &limitMoment); Tcl_SetObjResult(interp, Tcl_NewLongObj(limitMoment.sec)); } break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { | | < | 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 | Tcl_LimitGetTime(slaveInterp, &limitMoment); Tcl_SetObjResult(interp, Tcl_NewLongObj(limitMoment.sec)); } break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { int i, scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; Tcl_Time limitMoment; |
︙ | ︙ | |||
4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 | granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { Tcl_AppendResult(interp, "granularity must be at " "least 1", NULL); return TCL_ERROR; } break; case OPT_MILLI: milliObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &milliLen); if (milliLen == 0) { break; } if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0) { Tcl_AppendResult(interp, "milliseconds must be at least 0", NULL); return TCL_ERROR; } limitMoment.usec = ((long)tmp)*1000; break; case OPT_SEC: secObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &secLen); if (secLen == 0) { break; } if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0) { Tcl_AppendResult(interp, "seconds must be at least 0", NULL); return TCL_ERROR; } limitMoment.sec = tmp; break; } } if (milliObj != NULL || secObj != NULL) { if (milliObj != NULL) { /* * Setting -milliseconds but clearing -seconds, or resetting * -milliseconds but not resetting -seconds? Bad voodoo! */ if (secObj != NULL && secLen == 0 && milliLen > 0) { Tcl_AppendResult(interp, "may only set -milliseconds " "if -seconds is not also being reset", NULL); return TCL_ERROR; } if (milliLen == 0 && (secObj == NULL || secLen > 0)) { Tcl_AppendResult(interp, "may only reset -milliseconds " "if -seconds is also being reset", NULL); return TCL_ERROR; } } if (milliLen > 0 || secLen > 0) { /* * Force usec to be in range [0..1000000), possibly | > > > > > > > > > > | 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 | granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { Tcl_AppendResult(interp, "granularity must be at " "least 1", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } break; case OPT_MILLI: milliObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &milliLen); if (milliLen == 0) { break; } if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0) { Tcl_AppendResult(interp, "milliseconds must be at least 0", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } limitMoment.usec = ((long)tmp)*1000; break; case OPT_SEC: secObj = objv[i+1]; (void) Tcl_GetStringFromObj(objv[i+1], &secLen); if (secLen == 0) { break; } if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0) { Tcl_AppendResult(interp, "seconds must be at least 0", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; } limitMoment.sec = tmp; break; } } if (milliObj != NULL || secObj != NULL) { if (milliObj != NULL) { /* * Setting -milliseconds but clearing -seconds, or resetting * -milliseconds but not resetting -seconds? Bad voodoo! */ if (secObj != NULL && secLen == 0 && milliLen > 0) { Tcl_AppendResult(interp, "may only set -milliseconds " "if -seconds is not also being reset", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", NULL); return TCL_ERROR; } if (milliLen == 0 && (secObj == NULL || secLen > 0)) { Tcl_AppendResult(interp, "may only reset -milliseconds " "if -seconds is also being reset", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", NULL); return TCL_ERROR; } } if (milliLen > 0 || secLen > 0) { /* * Force usec to be in range [0..1000000), possibly |
︙ | ︙ |
Changes to generic/tclListObj.c.
︙ | ︙ | |||
1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 | } indexArray++; if (index < 0 || index > elemCount) { /* ...the index points outside the sublist. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); break; } /* * No error conditions. As long as we're not yet on the last index, * determine the next sublist for the next pass through the loop, and * take steps to make sure it is an unshared copy, as we intend to | > > | 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 | } indexArray++; if (index < 0 || index > elemCount) { /* ...the index points outside the sublist. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", NULL); break; } /* * No error conditions. As long as we're not yet on the last index, * determine the next sublist for the next pass through the loop, and * take steps to make sure it is an unshared copy, as we intend to |
︙ | ︙ | |||
1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 | if (listPtr->typePtr != &tclListType) { int length, result; (void) TclGetStringFromObj(listPtr, &length); if (!length) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); return TCL_ERROR; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = listPtr->internalRep.twoPtrValue.ptr1; elemCount = listRepPtr->elemCount; elemPtrs = &listRepPtr->elements; /* * Ensure that the index is in bounds. */ if (index<0 || index>=elemCount) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); } return TCL_ERROR; } /* * If the internal rep is shared, replace it with an unshared copy. */ | > > > > | 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 | if (listPtr->typePtr != &tclListType) { int length, result; (void) TclGetStringFromObj(listPtr, &length); if (!length) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", NULL); return TCL_ERROR; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = listPtr->internalRep.twoPtrValue.ptr1; elemCount = listRepPtr->elemCount; elemPtrs = &listRepPtr->elements; /* * Ensure that the index is in bounds. */ if (index<0 || index>=elemCount) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", NULL); } return TCL_ERROR; } /* * If the internal rep is shared, replace it with an unshared copy. */ |
︙ | ︙ |
Changes to generic/tclLoad.c.
︙ | ︙ | |||
156 157 158 159 160 161 162 163 164 165 166 167 168 169 | packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { Tcl_SetResult(interp, "must specify either file name or package name", TCL_STATIC); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the package into. */ | > > | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 | packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { Tcl_SetResult(interp, "must specify either file name or package name", TCL_STATIC); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY", NULL); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the package into. */ |
︙ | ︙ | |||
222 223 224 225 226 227 228 229 230 231 232 233 234 235 | /* * Can't have two different packages loaded from the same file. */ Tcl_AppendResult(interp, "file \"", fullFileName, "\" is already loaded for package \"", pkgPtr->packageName, "\"", NULL); code = TCL_ERROR; Tcl_MutexUnlock(&packageMutex); goto done; } } Tcl_MutexUnlock(&packageMutex); if (pkgPtr == NULL) { | > > | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 | /* * Can't have two different packages loaded from the same file. */ Tcl_AppendResult(interp, "file \"", fullFileName, "\" is already loaded for package \"", pkgPtr->packageName, "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "SPLITPERSONALITY", NULL); code = TCL_ERROR; Tcl_MutexUnlock(&packageMutex); goto done; } } Tcl_MutexUnlock(&packageMutex); if (pkgPtr == NULL) { |
︙ | ︙ | |||
257 258 259 260 261 262 263 264 265 266 267 268 269 270 | * The desired file isn't currently loaded, so load it. It's an error * if the desired package is a static one. */ if (fullFileName[0] == 0) { Tcl_AppendResult(interp, "package \"", packageName, "\" isn't loaded statically", NULL); code = TCL_ERROR; goto done; } /* * Figure out the module name if it wasn't provided explicitly. */ | > > | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 | * The desired file isn't currently loaded, so load it. It's an error * if the desired package is a static one. */ if (fullFileName[0] == 0) { Tcl_AppendResult(interp, "package \"", packageName, "\" isn't loaded statically", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC", NULL); code = TCL_ERROR; goto done; } /* * Figure out the module name if it wasn't provided explicitly. */ |
︙ | ︙ | |||
308 309 310 311 312 313 314 315 316 317 318 319 320 321 | } } if (p == pkgGuess) { Tcl_DecrRefCount(splitPtr); Tcl_AppendResult(interp, "couldn't figure out package name for ", fullFileName, NULL); code = TCL_ERROR; goto done; } Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); Tcl_DecrRefCount(splitPtr); } } | > > | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 | } } if (p == pkgGuess) { Tcl_DecrRefCount(splitPtr); Tcl_AppendResult(interp, "couldn't figure out package name for ", fullFileName, NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "WHATPACKAGE", NULL); code = TCL_ERROR; goto done; } Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); Tcl_DecrRefCount(splitPtr); } } |
︙ | ︙ | |||
403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | */ if (Tcl_IsSafe(target)) { if (pkgPtr->safeInitProc == NULL) { Tcl_AppendResult(interp, "can't use package in a safe interpreter: no ", pkgPtr->packageName, "_SafeInit procedure", NULL); code = TCL_ERROR; goto done; } code = pkgPtr->safeInitProc(target); } else { code = pkgPtr->initProc(target); } /* * Record the fact that the package has been loaded in the target * interpreter. */ | > > > > > > > > > > > | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 | */ if (Tcl_IsSafe(target)) { if (pkgPtr->safeInitProc == NULL) { Tcl_AppendResult(interp, "can't use package in a safe interpreter: no ", pkgPtr->packageName, "_SafeInit procedure", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE", NULL); code = TCL_ERROR; goto done; } code = pkgPtr->safeInitProc(target); } else { if (pkgPtr->initProc == NULL) { Tcl_AppendResult(interp, "can't attach package to interpreter: no ", pkgPtr->packageName, "_Init procedure", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT", NULL); code = TCL_ERROR; goto done; } code = pkgPtr->initProc(target); } /* * Record the fact that the package has been loaded in the target * interpreter. */ |
︙ | ︙ | |||
551 552 553 554 555 556 557 558 559 560 561 562 563 564 | packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { Tcl_SetResult(interp, "must specify either file name or package name", TCL_STATIC); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the package into. */ | > > | 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 | packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { Tcl_SetResult(interp, "must specify either file name or package name", TCL_STATIC); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", NULL); code = TCL_ERROR; goto done; } /* * Figure out which interpreter we're going to load the package into. */ |
︙ | ︙ | |||
622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 | if (fullFileName[0] == 0) { /* * It's an error to try unload a static package. */ Tcl_AppendResult(interp, "package \"", packageName, "\" is loaded statically and cannot be unloaded", NULL); code = TCL_ERROR; goto done; } if (pkgPtr == NULL) { /* * The DLL pointed by the provided filename has never been loaded. */ Tcl_AppendResult(interp, "file \"", fullFileName, "\" has never been loaded", NULL); code = TCL_ERROR; goto done; } /* * Scan through the list of packages already loaded in the target * interpreter. If the package we want is already loaded there, then we | > > > > | 643 644 645 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 | if (fullFileName[0] == 0) { /* * It's an error to try unload a static package. */ Tcl_AppendResult(interp, "package \"", packageName, "\" is loaded statically and cannot be unloaded", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC", NULL); code = TCL_ERROR; goto done; } if (pkgPtr == NULL) { /* * The DLL pointed by the provided filename has never been loaded. */ Tcl_AppendResult(interp, "file \"", fullFileName, "\" has never been loaded", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", NULL); code = TCL_ERROR; goto done; } /* * Scan through the list of packages already loaded in the target * interpreter. If the package we want is already loaded there, then we |
︙ | ︙ | |||
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 688 689 690 691 692 693 694 | if (code != TCL_OK) { /* * The package has not been loaded in this interpreter. */ Tcl_AppendResult(interp, "file \"", fullFileName, "\" has never been loaded in this interpreter", NULL); code = TCL_ERROR; goto done; } /* * Ensure that the DLL can be unloaded. If it is a trusted interpreter, * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL. */ if (Tcl_IsSafe(target)) { if (pkgPtr->safeUnloadProc == NULL) { Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded under a safe interpreter", NULL); code = TCL_ERROR; goto done; } unloadProc = pkgPtr->safeUnloadProc; } else { if (pkgPtr->unloadProc == NULL) { Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded under a trusted interpreter", NULL); code = TCL_ERROR; goto done; } unloadProc = pkgPtr->unloadProc; } /* | > > > > > > | 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 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 | if (code != TCL_OK) { /* * The package has not been loaded in this interpreter. */ Tcl_AppendResult(interp, "file \"", fullFileName, "\" has never been loaded in this interpreter", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", NULL); code = TCL_ERROR; goto done; } /* * Ensure that the DLL can be unloaded. If it is a trusted interpreter, * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL. */ if (Tcl_IsSafe(target)) { if (pkgPtr->safeUnloadProc == NULL) { Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded under a safe interpreter", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", NULL); code = TCL_ERROR; goto done; } unloadProc = pkgPtr->safeUnloadProc; } else { if (pkgPtr->unloadProc == NULL) { Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded under a trusted interpreter", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", NULL); code = TCL_ERROR; goto done; } unloadProc = pkgPtr->unloadProc; } /* |
︙ | ︙ | |||
767 768 769 770 771 772 773 | * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get * a core on exit because it wants to call a function in the dll after * it's been unloaded. */ if (pkgPtr->fileName[0] != '\0') { | < | | 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 | * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get * a core on exit because it wants to call a function in the dll after * it's been unloaded. */ if (pkgPtr->fileName[0] != '\0') { Tcl_MutexLock(&packageMutex); if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) { /* * Remove this library from the loaded library cache. */ defaultPtr = pkgPtr; if (defaultPtr == firstPackagePtr) { |
︙ | ︙ | |||
820 821 822 823 824 825 826 827 828 829 830 831 832 833 | } else { code = TCL_ERROR; } } #else Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded: unloading disabled", NULL); code = TCL_ERROR; #endif } done: Tcl_DStringFree(&pkgName); Tcl_DStringFree(&tmp); | > > | 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 | } else { code = TCL_ERROR; } } #else Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded: unloading disabled", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED", NULL); code = TCL_ERROR; #endif } done: Tcl_DStringFree(&pkgName); Tcl_DStringFree(&tmp); |
︙ | ︙ |