From 1b1224956e7822fee36c2f2d65a69540e78b0d46 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 16 May 2024 15:38:08 +0000
Subject: Test that hits [87271f7cd6] reasonably precisely

---
 tests/oo.test | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

diff --git a/tests/oo.test b/tests/oo.test
index abd5d31..fa2adf8 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3296,6 +3296,46 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup {
 } -match glob -cleanup {
     c destroy
 } -result {* cmd {info frame 0} method test class ::c level 0}
+test oo-22.3 {OO and coroutines and info frame} -setup {
+    oo::class create A {
+	self method run {nworkers} {
+	    set ::result {}
+	    set workers {}
+	    for {set n 1} {$n <= $nworkers} {incr n} {
+		set worker [A create a$n]
+		lappend workers $worker
+		$worker schedule
+	    }
+	    after 250 [namespace code {variable forever false}]
+	    variable forever true
+	    vwait [my varname forever]
+	    foreach worker $workers {
+		$worker destroy
+	    }
+	    return $::result
+	}
+    	method schedule {} {
+	    set coro coro-[namespace tail [self]]
+	    if {[llength [info commands $coro]] == 0} {
+		coroutine $coro my Work
+	    }
+	}
+	method Work {} {
+	    after 0 [info coroutine]
+	    yield
+	    lappend ::result [dump]
+	}
+    }
+} -body {
+    # Triggers a crash with incorrectly restored procPtr->cmdPtr
+    proc dump {} {
+	info frame [expr {[info frame] - 1}]
+    }
+    A run 2
+} -cleanup {
+    catch {rename dump {}}
+    catch {A destroy}
+} -match glob -result {{* method Work object *} {* method Work object *}}
 
 # Prove that the issue in [Bug 1865054] isn't an issue any more
 test oo-23.1 {Self-like derivation; complex case!} -setup {
-- 
cgit v0.12


From fb0026a7a9c621672554d7f9c77c2cbdfa61be60 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 16 May 2024 15:43:21 +0000
Subject: Make sure we're looking for the right results

---
 tests/oo.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/oo.test b/tests/oo.test
index fa2adf8..38fb276 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3335,7 +3335,7 @@ test oo-22.3 {OO and coroutines and info frame} -setup {
 } -cleanup {
     catch {rename dump {}}
     catch {A destroy}
-} -match glob -result {{* method Work object *} {* method Work object *}}
+} -match glob -result {{* method Work class ::A *} {* method Work class ::A *}}
 
 # Prove that the issue in [Bug 1865054] isn't an issue any more
 test oo-23.1 {Self-like derivation; complex case!} -setup {
-- 
cgit v0.12


From 71e8e7a16883b76aaf0d406d59c8799f5c50b157 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 16 May 2024 15:51:42 +0000
Subject: Apply an emergency workaround

---
 generic/tclCmdIL.c | 7 ++++++-
 tests/oo.test      | 3 ++-
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index aef0399..279bc7b 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1388,7 +1388,12 @@ TclInfoFrame(
      * Procedure CallFrame.
      */
 
-    if (procPtr != NULL) {
+    if (procPtr != NULL
+#ifndef AVOID_EMERGENCY_HACKS
+	    /* Emergency band-aid fix for [87271f7cd6] */
+	    && procPtr->cmdPtr != NULL
+#endif
+	    ) {
 	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
 
 	if (namePtr) {
diff --git a/tests/oo.test b/tests/oo.test
index 38fb276..7266255 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3296,7 +3296,8 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup {
 } -match glob -cleanup {
     c destroy
 } -result {* cmd {info frame 0} method test class ::c level 0}
-test oo-22.3 {OO and coroutines and info frame} -setup {
+# BUG: second call is missing info (caused by workaround in tclCmdIL.c)
+test oo-22.3 {OO and coroutines and info frame} -constraints knownBug -setup {
     oo::class create A {
 	self method run {nworkers} {
 	    set ::result {}
-- 
cgit v0.12