summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2019-11-14 19:30:23 (GMT)
committersebres <sebres@users.sourceforge.net>2019-11-14 19:30:23 (GMT)
commitb350e6ad910681ff6c967a7fcff789e11d6c3403 (patch)
tree25ed06676e82d416b1f808f46f2c497f8ce5109d
parent37076881576fb0897e3c1c257ca37cd87685da0c (diff)
parent434361c3c66494a5fb28d24bdf591b9ac803673c (diff)
downloadtcl-b350e6ad910681ff6c967a7fcff789e11d6c3403.zip
tcl-b350e6ad910681ff6c967a7fcff789e11d6c3403.tar.gz
tcl-b350e6ad910681ff6c967a7fcff789e11d6c3403.tar.bz2
fixes bug [135804138e]
-rw-r--r--generic/tclOOMethod.c8
-rw-r--r--tests/oo.test29
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