Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Proper fix for [87271f7cd6]. Structures relating to [info frame] in a method now have the correct lifetime. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-8-branch |
Files: | files | file ages | folders |
SHA3-256: |
612af6e7d6ea04a3fc5904ee31462e02 |
User & Date: | dkf 2024-05-17 13:45:50 |
Context
2024-05-18
| ||
21:58 | Update changes.md check-in: 568f98c34d user: jan.nijtmans tags: core-8-branch | |
2024-05-17
| ||
20:40 | Merge 8.7. Improve tcl::build-info Leaf check-in: e94e6e3cec user: jan.nijtmans tags: libtommath-1.3.1 | |
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 | |
13:45 | Proper fix for [87271f7cd6]. Structures relating to [info frame] in a method now have the correct li... check-in: 612af6e7d6 user: dkf tags: core-8-branch | |
13:43 | Proper fix for [87271f7cd6]. Structures relating to [info frame] in a method now have the correct li... check-in: 371e968deb user: dkf tags: core-8-6-branch | |
2024-05-16
| ||
15:55 | Apply emergency workaround for [87271f7cd6]; not fixed yet, but no longer crashes check-in: 9208e56d48 user: dkf tags: core-8-branch | |
Changes
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
1375 1376 1377 1378 1379 1380 1381 | } /* * 'proc'. Common to all frame types. Conditional on having an associated * Procedure CallFrame. */ | | < < < < < | 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 | } /* * 'proc'. Common to all frame types. Conditional on having an associated * Procedure CallFrame. */ if (procPtr != NULL) { Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; if (namePtr) { Tcl_Obj *procNameObj; /* * This is a regular command. |
︙ | ︙ |
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 *) ckalloc(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. |
︙ | ︙ | |||
338 339 340 341 342 343 344 | int argsLen; ProcedureMethod *pmPtr; Tcl_Method method; if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } | < < < < < | | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 | int 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) { ckfree(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } |
︙ | ︙ | |||
399 400 401 402 403 404 405 | procName = "<destructor>"; } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } else { procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); } | < < < < < | | 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 | 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 == -1) { Tcl_DecrRefCount(argsObj); } if (method == NULL) { |
︙ | ︙ | |||
654 655 656 657 658 659 660 | * How to invoke a procedure-like method. * * ---------------------------------------------------------------------- */ static int InvokeProcedureMethod( | | | 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 | * 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; |
︙ | ︙ | |||
677 678 679 680 681 682 683 684 685 686 687 688 689 690 | 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)); | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 | 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)); |
︙ | ︙ | |||
707 708 709 710 711 712 713 | if (pmPtr->preCallProc != NULL) { int isFinished; result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { | < < < < < < < | 727 728 729 730 731 732 733 734 735 736 737 738 739 740 | 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; |
︙ | ︙ | |||
754 755 756 757 758 759 760 | if (pmPtr->postCallProc) { result = pmPtr->postCallProc(pmPtr->clientData, interp, context, Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)), result); } | < < < < < < < | 767 768 769 770 771 772 773 774 775 776 777 778 779 780 | 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) { |
︙ | ︙ | |||
787 788 789 790 791 792 793 | 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; | < < < < < | < < < < < < < < | < | < < < < < < < > | > | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | 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. -- * |
︙ | ︙ | |||
1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 | *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) { | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 | *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 -- * |
︙ | ︙ | |||
1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 | * Create the actual copy of the method record, manufacturing a new proc * record. */ pm2Ptr = (ProcedureMethod *)ckalloc(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); ckfree(pm2Ptr); | > > | 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 | * Create the actual copy of the method record, manufacturing a new proc * record. */ pm2Ptr = (ProcedureMethod *)ckalloc(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); ckfree(pm2Ptr); |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
3437 3438 3439 3440 3441 3442 3443 | 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} | < | > | | | > | > < | | < > | < | > > | > > > > > > | | | > > > | | | | | | | < < < < < < < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 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 | 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 |
︙ | ︙ |