Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Bring over bug fixes from trunk to get released |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-9-0-b2-rc | core-9-0-b2 |
Files: | files | file ages | folders |
SHA3-256: |
3266fc297b4ae23ee1ddffb7fe35c1ed |
User & Date: | dgp 2024-05-17 16:07:10 |
Context
2024-05-20
| ||
17:52 | merge release check-in: 4e112bcda6 user: dgp tags: dgp-trunk-unchurned | |
2024-05-17
| ||
16:07 | Bring over bug fixes from trunk to get released Closed-Leaf check-in: 3266fc297b user: dgp tags: core-9-0-b2-rc, core-9-0-b2 | |
13:48 | Proper fix for [87271f7cd6]. Structures relating to [info frame] in a method now have the correct li... check-in: db8bfb98f1 user: dkf tags: trunk, main | |
2024-05-14
| ||
19:08 | Merge [4a1848c27fd63955], which was improperly backed-out (there was no notice or public discussion)... check-in: ff38221d4e user: dgp tags: core-9-0-b2-rc | |
Changes
Changes to generic/tclOOInfo.c.
︙ | ︙ | |||
617 618 619 620 621 622 623 | Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(names[i], -1)); } if (numNames > 0) { Tcl_Free((void *)names); } } else if (oPtr->methodsPtr) { | > > > > > > | > > > > > > | | > | 617 618 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 | Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(names[i], -1)); } if (numNames > 0) { Tcl_Free((void *)names); } } else if (oPtr->methodsPtr) { if (scope == -1) { /* * Handle legacy-mode matching. [Bug 36e5517a6850] */ int scopeFilter = flag | TRUE_PRIVATE_METHOD; FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { if (mPtr->typePtr && (mPtr->flags & scopeFilter) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } } else { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } |
︙ | ︙ | |||
1374 1375 1376 1377 1378 1379 1380 | } if (numNames > 0) { Tcl_Free((void *)names); } } else { FOREACH_HASH_DECLS; | > > > > > > | > > > > > > | | > | 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 | } if (numNames > 0) { Tcl_Free((void *)names); } } else { FOREACH_HASH_DECLS; if (scope == -1) { /* * Handle legacy-mode matching. [Bug 36e5517a6850] */ int scopeFilter = flag | TRUE_PRIVATE_METHOD; FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { if (mPtr->typePtr && (mPtr->flags & scopeFilter) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } } else { FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclOOInt.h.
︙ | ︙ | |||
93 94 95 96 97 98 99 100 101 102 103 104 105 106 | * before the method executes. */ TclOO_PostCallProc *postCallProc; /* Callback to allow for additional cleanup * after the method executes. */ GetFrameInfoValueProc *gfivProc; /* Callback to allow for fine tuning of how * the method reports itself. */ } ProcedureMethod; #define TCLOO_PROCEDURE_METHOD_VERSION 0 /* * Flags for use in a ProcedureMethod. * | > > > > > > > > > > | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | * before the method executes. */ TclOO_PostCallProc *postCallProc; /* Callback to allow for additional cleanup * after the method executes. */ GetFrameInfoValueProc *gfivProc; /* Callback to allow for fine tuning of how * the method reports itself. */ Command cmd; /* Space used to connect to [info frame] */ ExtraFrameInfo efi; /* Space used to store data for [info frame] */ Tcl_Interp *interp; /* Interpreter in which to compute the name of * the method. */ Tcl_Method method; /* Method to compute the name of. */ int callSiteFlags; /* Flags from the call chain. Only interested * in whether this is a constructor or * destructor, which we can't know until then * for messy reasons. Other flags are variable * but not used. */ } ProcedureMethod; #define TCLOO_PROCEDURE_METHOD_VERSION 0 /* * Flags for use in a ProcedureMethod. * |
︙ | ︙ |
Changes to generic/tclOOMethod.c.
︙ | ︙ | |||
12 13 14 15 16 17 18 | #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" #include "tclCompile.h" | < < < < < < < < < < < | < < < | < < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" #include "tclCompile.h" /* * Structure used to contain all the information needed about a call frame * used in a procedure-like method. */ typedef struct { CallFrame *framePtr; /* Reference to the call frame itself (it's * actually allocated on the Tcl stack). */ ProcErrorProc *errProc; /* The error handler for the body. */ Tcl_Obj *nameObj; /* The "name" of the command. Only used for a * few moments, so not reference. */ } PMFrameData; /* * Structure used to pass information about variable resolution to the * on-the-ground resolvers used when working with resolved compiled variables. */ |
︙ | ︙ | |||
79 80 81 82 83 84 85 86 87 88 89 90 91 92 | static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr); static void DeleteProcedureMethod(void *clientData); static int CloneProcedureMethod(Tcl_Interp *interp, void *clientData, void **newClientData); static ProcErrorProc MethodErrorHandler; static ProcErrorProc ConstructorErrorHandler; static ProcErrorProc DestructorErrorHandler; static Tcl_Obj * RenderDeclarerName(void *clientData); static int InvokeForwardMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static void DeleteForwardMethod(void *clientData); static int CloneForwardMethod(Tcl_Interp *interp, void *clientData, void **newClientData); | > | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr); static void DeleteProcedureMethod(void *clientData); static int CloneProcedureMethod(Tcl_Interp *interp, void *clientData, void **newClientData); static ProcErrorProc MethodErrorHandler; static ProcErrorProc ConstructorErrorHandler; static ProcErrorProc DestructorErrorHandler; static Tcl_Obj * RenderMethodName(void *clientData); static Tcl_Obj * RenderDeclarerName(void *clientData); static int InvokeForwardMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static void DeleteForwardMethod(void *clientData); static int CloneForwardMethod(Tcl_Interp *interp, void *clientData, void **newClientData); |
︙ | ︙ | |||
110 111 112 113 114 115 116 117 118 119 120 121 122 123 | * Helper macros (derived from things private to tclVar.c) */ #define TclVarTable(contextNs) \ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry))) /* * ---------------------------------------------------------------------- * * Tcl_NewInstanceMethod -- * * Attach a method to an object instance. | > > > > > > > > > > > > > > | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | * Helper macros (derived from things private to tclVar.c) */ #define TclVarTable(contextNs) \ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry))) static inline ProcedureMethod * AllocProcedureMethodRecord( int flags) { ProcedureMethod *pmPtr = (ProcedureMethod *) Tcl_Alloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; pmPtr->refCount = 1; pmPtr->cmd.clientData = &pmPtr->efi; return pmPtr; } /* * ---------------------------------------------------------------------- * * Tcl_NewInstanceMethod -- * * Attach a method to an object instance. |
︙ | ︙ | |||
424 425 426 427 428 429 430 | Tcl_Size argsLen; ProcedureMethod *pmPtr; Tcl_Method method; if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } | < < < < < | | 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 | Tcl_Size argsLen; ProcedureMethod *pmPtr; Tcl_Method method; if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } pmPtr = AllocProcedureMethodRecord(flags); method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { Tcl_Free(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } |
︙ | ︙ | |||
485 486 487 488 489 490 491 | procName = "<destructor>"; } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } else { procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); } | < < < < < | | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 | procName = "<destructor>"; } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } else { procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); } pmPtr = AllocProcedureMethodRecord(flags); method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (argsLen == TCL_INDEX_NONE) { Tcl_DecrRefCount(argsObj); } if (method == NULL) { |
︙ | ︙ | |||
740 741 742 743 744 745 746 | * How to invoke a procedure-like method. * * ---------------------------------------------------------------------- */ static int InvokeProcedureMethod( | | | 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 | * How to invoke a procedure-like method. * * ---------------------------------------------------------------------- */ static int InvokeProcedureMethod( void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { ProcedureMethod *pmPtr = (ProcedureMethod *)clientData; int result; |
︙ | ︙ | |||
762 763 764 765 766 767 768 769 770 771 772 773 774 775 | */ if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) || Tcl_InterpDeleted(interp)) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } /* * Allocate the special frame data. */ fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData)); | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 | */ if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) || Tcl_InterpDeleted(interp)) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } /* * Finishes filling out the extra frame info so that [info frame] works if * that is not already set up. */ if (pmPtr->efi.length == 0) { Tcl_Method method = Tcl_ObjectContextMethod(context); pmPtr->efi.length = 2; pmPtr->efi.fields[0].name = "method"; pmPtr->efi.fields[0].proc = RenderMethodName; pmPtr->efi.fields[0].clientData = pmPtr; pmPtr->callSiteFlags = ((CallContext *) context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR); pmPtr->interp = interp; pmPtr->method = method; if (pmPtr->gfivProc != NULL) { pmPtr->efi.fields[1].name = ""; pmPtr->efi.fields[1].proc = pmPtr->gfivProc; pmPtr->efi.fields[1].clientData = pmPtr; } else { if (Tcl_MethodDeclarerObject(method) != NULL) { pmPtr->efi.fields[1].name = "object"; } else { pmPtr->efi.fields[1].name = "class"; } pmPtr->efi.fields[1].proc = RenderDeclarerName; pmPtr->efi.fields[1].clientData = pmPtr; } } /* * Allocate the special frame data. */ fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData)); |
︙ | ︙ | |||
792 793 794 795 796 797 798 | if (pmPtr->preCallProc != NULL) { int isFinished; result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { | < < < < < < < | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 | if (pmPtr->preCallProc != NULL) { int isFinished; result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } TclStackFree(interp, fdPtr); return result; |
︙ | ︙ | |||
839 840 841 842 843 844 845 | if (pmPtr->postCallProc) { result = pmPtr->postCallProc(pmPtr->clientData, interp, context, Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)), result); } | < < < < < < < | 852 853 854 855 856 857 858 859 860 861 862 863 864 865 | if (pmPtr->postCallProc) { result = pmPtr->postCallProc(pmPtr->clientData, interp, context, Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)), result); } /* * Scrap the special frame data now that we're done with it. Note that we * are inlining DeleteProcedureMethod() here; this location is highly * sensitive when it comes to performance! */ if (pmPtr->refCount-- <= 1) { |
︙ | ︙ | |||
872 873 874 875 876 877 878 | int objc, /* Number of arguments. */ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; int result; | < < < < < | < < < < < < < < | < | < < < < < < < > | > | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 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 963 964 | int objc, /* Number of arguments. */ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; int result; CallFrame **framePtrPtr = &fdPtr->framePtr; ByteCode *codePtr; /* * Compute basic information on the basis of the type of method it is. */ if (contextPtr->callPtr->flags & CONSTRUCTOR) { fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName; fdPtr->errProc = ConstructorErrorHandler; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName; fdPtr->errProc = DestructorErrorHandler; } else { fdPtr->nameObj = Tcl_MethodName( Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr)); fdPtr->errProc = MethodErrorHandler; } if (pmPtr->errProc != NULL) { fdPtr->errProc = pmPtr->errProc; } /* * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = (Namespace *) mPtr->declaringClassPtr->thisPtr->namespacePtr; } else { nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr; } } /* * Compile the body. * * [Bug 2037727] Always call TclProcCompileProc so that we check not only * that we have bytecode, but also that it remains valid. Note that we set * the namespace of the code here directly; this is a hack, but the * alternative is *so* slow... */ pmPtr->procPtr->cmdPtr = &pmPtr->cmd; ByteCodeGetInternalRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr); if (codePtr) { codePtr->nsPtr = nsPtr; } result = TclProcCompileProc(interp, pmPtr->procPtr, pmPtr->procPtr->bodyPtr, nsPtr, "body of method", TclGetString(fdPtr->nameObj)); if (result != TCL_OK) { return result; } /* * Make the stack frame and fill it out with information about this call. * This operation doesn't ever actually fail. */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD); fdPtr->framePtr->clientData = contextPtr; fdPtr->framePtr->objc = objc; fdPtr->framePtr->objv = objv; fdPtr->framePtr->procPtr = pmPtr->procPtr; return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOOSetupVariableResolver, etc. -- * |
︙ | ︙ | |||
1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 | *rPtrPtr = &infoPtr->info; return TCL_OK; } /* * ---------------------------------------------------------------------- * * RenderDeclarerName -- * * Returns the name of the entity (object or class) which declared a * method. Used for producing information for [info frame] in such a way * that the expensive part of this (generating the object or class name * itself) isn't done until it is needed. * * ---------------------------------------------------------------------- */ static Tcl_Obj * RenderDeclarerName( void *clientData) { | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 | *rPtrPtr = &infoPtr->info; return TCL_OK; } /* * ---------------------------------------------------------------------- * * RenderMethodName -- * * Returns the name of the declared method. Used for producing information * for [info frame]. * * ---------------------------------------------------------------------- */ static Tcl_Obj * RenderMethodName( void *clientData) { ProcedureMethod *pmPtr = (ProcedureMethod *) clientData; if (pmPtr->callSiteFlags & CONSTRUCTOR) { return TclOOGetFoundation(pmPtr->interp)->constructorName; } else if (pmPtr->callSiteFlags & DESTRUCTOR) { return TclOOGetFoundation(pmPtr->interp)->destructorName; } else { return Tcl_MethodName(pmPtr->method); } } /* * ---------------------------------------------------------------------- * * RenderDeclarerName -- * * Returns the name of the entity (object or class) which declared a * method. Used for producing information for [info frame] in such a way * that the expensive part of this (generating the object or class name * itself) isn't done until it is needed. * * ---------------------------------------------------------------------- */ static Tcl_Obj * RenderDeclarerName( void *clientData) { ProcedureMethod *pmPtr = (ProcedureMethod *) clientData; Tcl_Object object = Tcl_MethodDeclarerObject(pmPtr->method); if (object == NULL) { object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pmPtr->method)); } return TclOOObjectName(pmPtr->interp, (Object *) object); } /* * ---------------------------------------------------------------------- * * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler -- * |
︙ | ︙ | |||
1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 | * Create the actual copy of the method record, manufacturing a new proc * record. */ pm2Ptr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; Tcl_IncrRefCount(argsObj); Tcl_IncrRefCount(bodyObj); if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, &pm2Ptr->procPtr) != TCL_OK) { Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); Tcl_Free(pm2Ptr); | > > | 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 | * Create the actual copy of the method record, manufacturing a new proc * record. */ pm2Ptr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; pm2Ptr->cmd.clientData = &pm2Ptr->efi; pm2Ptr->efi.length = 0; /* Trigger a reinit of this. */ Tcl_IncrRefCount(argsObj); Tcl_IncrRefCount(bodyObj); if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, &pm2Ptr->procPtr) != TCL_OK) { Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); Tcl_Free(pm2Ptr); |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 | c create o } -body { lsort [info object methods o -all -private] } -cleanup { o destroy c destroy } -result $stdmethods test oo-18.1 {OO: define command support} { list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo } {1 foo {foo while executing "error foo" | > > > > > > > > > > > > > > > > > > > > > > > > | 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 | c create o } -body { lsort [info object methods o -all -private] } -cleanup { o destroy c destroy } -result $stdmethods test oo-17.15 {OO: class method list without -all (bug 36e5517a6850)} -setup { oo::class create c } -body { oo::define c { method foo {} {} method Bar {} {} private method gorp {} {} } list [lsort [info class methods c]] [lsort [info class methods c -private]] } -cleanup { c destroy } -result {foo {Bar foo}} test oo-17.16 {OO: instance method list without -all (bug 36e5517a6850)} -setup { oo::object create o } -body { oo::objdefine o { method foo {} {} method Bar {} {} private method gorp {} {} } list [lsort [info object methods o]] [lsort [info object methods o -private]] } -cleanup { o destroy } -result {foo {Bar foo}} test oo-18.1 {OO: define command support} { list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo } {1 foo {foo while executing "error foo" |
︙ | ︙ | |||
3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 | lsort {q w e r t y u i o p}; # Overwrite the Tcl stack info frame 0 } [c new] test } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { oo::class create SELF { superclass oo::class unexport create new # Next is just a convenience | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 | lsort {q w e r t y u i o p}; # Overwrite the Tcl stack info frame 0 } [c new] test } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} # Common code for oo-22.{3,4,5,6} oo::class create WorkerBase oo::class create WorkerSupport { superclass oo::class WorkerBase variable result stop method WithWorkers {nworkers args script} { set workers {} try { for {set n 1} {$n <= $nworkers} {incr n} { lappend workers [set worker [[self] new]] $worker schedule {*}$args } return [uplevel 1 $script] } finally { foreach worker $workers {$worker destroy} } } method run {nworkers} { set result {} set stopvar [my varname stop] set stop false my WithWorkers $nworkers [list my Work [my varname result]] { after idle [namespace code {set stop true}] vwait $stopvar } return $result } } oo::class create Worker { superclass WorkerBase method schedule {args} { set coro [namespace current]::coro if {![llength [info commands $coro]]} { coroutine $coro {*}$args } } method Work args {error unimplemented} method dump {} { info frame [expr {[info frame] - 1}] } } test oo-22.3 {OO and coroutines and info frame: Bug 87271f7cd6} -body { # Triggers a crash with incorrectly restored pmPtr->procPtr->cmdPtr WorkerSupport create A { superclass Worker method Work {var} { after 0 [info coroutine] yield lappend $var [my dump] } } A run 2 } -cleanup { catch {rename dump {}} catch {A destroy} } -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} test oo-22.4 {OO and coroutines and info frame: Bug 87271f7cd6} -body { # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr WorkerSupport create A { superclass Worker method Work {var} { after 0 [info coroutine] yield lappend $var [my dump] } } # Copies the methods, changing the declarer # Test it works with the source class still around oo::copy A B B run 2 } -cleanup { catch {rename dump {}} catch {A destroy} catch {B destroy} } -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} test oo-22.5 {OO and coroutines and info frame: Bug 87271f7cd6} -body { # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr WorkerSupport create A { superclass Worker method Work {var} { after 0 [info coroutine] yield lappend $var [my dump] } } # Copies the methods, changing the declarer # Test it works with the source class deleted oo::copy A B catch {A destroy} B run 2 } -cleanup { catch {rename dump {}} catch {B destroy} } -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} test oo-22.6 {OO and coroutines and info frame: Bug 87271f7cd6} -body { # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr WorkerSupport create A { superclass Worker method Work {var} { after 0 [info coroutine] yield lappend $var [my dump] } } # Copies the methods, changing the declarer # Test it works in the original source class with the copy around oo::copy A B B run 2 A run 2 } -cleanup { catch {rename dump {}} catch {A destroy} catch {B destroy} } -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} WorkerBase destroy # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { oo::class create SELF { superclass oo::class unexport create new # Next is just a convenience |
︙ | ︙ |