summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2008-10-08 15:10:30 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2008-10-08 15:10:30 (GMT)
commit3dac24314a5483f488d9d5255b7fb6bbeba91b3b (patch)
tree24e837db74d4613110a015e7dc96020d98a846ac
parent7d5aead5703d324d80a98cf890f90b9a452cb9a2 (diff)
downloadtcl-3dac24314a5483f488d9d5255b7fb6bbeba91b3b.zip
tcl-3dac24314a5483f488d9d5255b7fb6bbeba91b3b.tar.gz
tcl-3dac24314a5483f488d9d5255b7fb6bbeba91b3b.tar.bz2
* 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]
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclBasic.c13
-rw-r--r--tests/unsupported.test12
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 {} {