From f370c68d92b4669981b3fa2574a2e32fa1911595 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 1 Aug 2013 13:21:04 +0000
Subject: Support type discovery in coroutines.

---
 generic/tclBasic.c |  8 ++++++--
 generic/tclZlib.c  |  6 ++++++
 tests/info.test    | 20 ++++++++++++++++++--
 3 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3dfb639..97cdc51 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -533,6 +533,7 @@ Tcl_CreateInterp(void)
         TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
         TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
         TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
+        TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine");
     }
 
     /*
@@ -1068,12 +1069,15 @@ TclGetCommandTypeName(
     Tcl_Command command)
 {
     Command *cmdPtr = (Command *) command;
+    void *procPtr = cmdPtr->objProc;
     const char *name = "native";
 
+    if (procPtr == NULL) {
+        procPtr = cmdPtr->nreProc;
+    }
     Tcl_MutexLock(&commandTypeLock);
     if (commandTypeInit) {
-        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable,
-                (void *) cmdPtr->objProc);
+        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);
 
         if (hPtr && Tcl_GetHashValue(hPtr)) {
             name = (const char *) Tcl_GetHashValue(hPtr);
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 9bceb4c..4907b45 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -3868,6 +3868,12 @@ TclZlibInit(
     Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");
 
     /*
+     * Allow command type introspection to do something sensible with streams.
+     */
+
+    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");
+
+    /*
      * Formally provide the package as a Tcl built-in.
      */
 
diff --git a/tests/info.test b/tests/info.test
index f3517f9..7cd6678 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -19,9 +19,9 @@ if {{::tcltest} ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
-
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]
+testConstraint zlib [llength [info commands zlib]]
 
 # Set up namespaces needed to test operation of "info args", "info body",
 # "info default", and "info procs" with imported procedures.
@@ -2488,7 +2488,23 @@ test info-40.13 {info cmdtype: ensembles} -setup {
 } -cleanup {
     namespace delete ::testinfocmdtype::ensmbl
 } -result ensemble
-test info-40.14 {info cmdtype: dynamic behavior} -setup {
+test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup {
+    namespace eval ::testinfocmdtype {
+	rename [zlib stream gzip] zstream
+    }
+} -body {
+    info cmdtype ::testinfocmdtype::zstream
+} -cleanup {
+    ::testinfocmdtype::zstream close
+} -result zlibStream
+test info-40.15 {info cmdtype: coroutines} -setup {
+    coroutine ::testinfocmdtype::coro eval yield
+} -body {
+    info cmdtype ::testinfocmdtype::coro
+} -cleanup {
+    ::testinfocmdtype::coro
+} -result coroutine
+test info-40.16 {info cmdtype: dynamic behavior} -setup {
     proc ::testinfocmdtype::foo {} {}
 } -body {
     namespace eval ::testinfocmdtype {
-- 
cgit v0.12