diff options
| author | sebres <sebres@users.sourceforge.net> | 2019-11-14 19:30:23 (GMT) |
|---|---|---|
| committer | sebres <sebres@users.sourceforge.net> | 2019-11-14 19:30:23 (GMT) |
| commit | b350e6ad910681ff6c967a7fcff789e11d6c3403 (patch) | |
| tree | 25ed06676e82d416b1f808f46f2c497f8ce5109d | |
| parent | 37076881576fb0897e3c1c257ca37cd87685da0c (diff) | |
| parent | 434361c3c66494a5fb28d24bdf591b9ac803673c (diff) | |
| download | tcl-b350e6ad910681ff6c967a7fcff789e11d6c3403.zip tcl-b350e6ad910681ff6c967a7fcff789e11d6c3403.tar.gz tcl-b350e6ad910681ff6c967a7fcff789e11d6c3403.tar.bz2 | |
fixes bug [135804138e]
| -rw-r--r-- | generic/tclOOMethod.c | 8 | ||||
| -rw-r--r-- | tests/oo.test | 29 |
2 files changed, 34 insertions, 3 deletions
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 3e64ba2..0c5f4bb 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -671,11 +671,13 @@ InvokeProcedureMethod( * call frame's lifetime). */ /* - * If the interpreter was deleted, we just skip to the next thing in the - * chain. + * If the object namespace (or interpreter) were deleted, we just skip to + * the next thing in the chain. */ - if (Tcl_InterpDeleted(interp)) { + if (!((CallContext *)context)->oPtr->namespacePtr || + Tcl_InterpDeleted(interp) + ) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } diff --git a/tests/oo.test b/tests/oo.test index b0704da..77fca68 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1353,6 +1353,35 @@ test oo-7.9 {OO: defining inheritance in namespaces} -setup { return } } -result {} +test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup { + set ::result "" + oo::class create c1 { + method m1 {} { + lappend ::result c1::m1 + } + } + oo::class create c2 { + superclass c1 + destructor { + lappend ::result c2::destructor + my m1 + lappend ::result /c2::destructor + } + method m1 {} { + lappend ::result c2::m1 + rename [self] {} + lappend ::result no-self + next + lappend ::result /c2::m1 + } + } +} -body { + c2 create o + lappend ::result [catch {o m1} msg] $msg +} -cleanup { + c1 destroy + unset ::result +} -result {c2::m1 c2::destructor c2::m1 no-self c1::m1 /c2::m1 /c2::destructor no-self 1 {no next method implementation}} test oo-8.1 {OO: global must work in methods} { oo::object create foo |
