Apply emergency workaround for [87271f7cd6]; not fixed yet, but no longer crashes

2 files changed, 47 insertions, 1 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index d3d0efc..2ce4491 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1379,7 +1379,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 cf8b710..8c6bc79 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3441,6 +3441,47 @@ 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}
+# 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 {}
+	    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 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 {