From 3dac24314a5483f488d9d5255b7fb6bbeba91b3b Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Wed, 8 Oct 2008 15:10:30 +0000
Subject: 	* generic/tclBasic (TclInfoCoroutineCmd): 	*
 tests/unsupported.test: arrange for [info coroutine] to return 	{}
 when a coroutine is running but the resume command has been 	deleted [Bug
 2153080]

---
 ChangeLog              |  7 +++++++
 generic/tclBasic.c     | 13 ++++++++-----
 tests/unsupported.test | 12 +++++++++++-
 3 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 6ab61fc..fe284a2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2008-10-08  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclBasic (TclInfoCoroutineCmd):
+	* tests/unsupported.test: arrange for [info coroutine] to return
+	{} when a coroutine is running but the resume command has been
+	deleted [Bug 2153080]
+	
 2008-10-08  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclTrace.c:	Corrected handling of errors returned by
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index afddfb6..b2c9e7c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.371 2008/10/07 17:57:42 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.372 2008/10/08 15:10:30 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -8498,10 +8498,13 @@ TclInfoCoroutineCmd(
     if (corPtr) {
 	Tcl_Command cmd = (Tcl_Command) corPtr->cmdPtr;
 	Tcl_Obj *namePtr;
-
-	TclNewObj(namePtr);
-	Tcl_GetCommandFullName(interp, cmd, namePtr);
-	Tcl_SetObjResult(interp, namePtr);
+	int deleted = (((Command *)cmd)->flags & CMD_IS_DELETED);
+	
+	if (!deleted) { 
+	    TclNewObj(namePtr);
+	    Tcl_GetCommandFullName(interp, cmd, namePtr);
+	    Tcl_SetObjResult(interp, namePtr);
+	}
     }
     return TCL_OK;
 }
diff --git a/tests/unsupported.test b/tests/unsupported.test
index c41d4bc..7085be6 100644
--- a/tests/unsupported.test
+++ b/tests/unsupported.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unsupported.test,v 1.12 2008/10/07 17:57:43 msofer Exp $
+# RCS: @(#) $Id: unsupported.test,v 1.13 2008/10/08 15:10:30 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -739,6 +739,16 @@ test unsupported-C.3.4 {info coroutine} -setup {
     rename b {}
 } -result ::foo
 
+test unsupported-C.3.5 {info coroutine} -setup {
+    proc a {} {info coroutine}
+    proc b {} {rename [info coroutine] {}; a}
+} -body {
+    coroutine foo b
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result {}
+
 
 test unsupported-C.4.1 {bug #2093188} -setup {
     proc foo {} {
-- 
cgit v0.12