* generic/tclCmdIL.c: Fix of [Bug #2910094] by aku

	* tests/coroutine.test:

3 files changed, 24 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index 1817cf8..4414ab0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2009-12-07  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclCmdIL.c:   Fix of [Bug #2910094] by aku
+	* tests/coroutine.test:
+
 	* generic/tclBasic.c: arrange for [tailcall] to be created with
 	the other builtins: was being created in a separate call, leftover
 	from pre-tip days.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index e84703b..9f9fdda 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.174 2009/11/18 21:59:51 nijtmans Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.175 2009/12/07 20:49:28 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1100,7 +1100,7 @@ InfoFrameCmd(
 	 * A coroutine: must fix the level computations
 	 */
 
-	topLevel += iPtr->execEnvPtr->corPtr->caller.cmdFramePtr->level + 1 -
+	topLevel += iPtr->execEnvPtr->corPtr->caller.cmdFramePtr->level -
 		iPtr->execEnvPtr->corPtr->base.cmdFramePtr->level;
     }
 
diff --git a/tests/coroutine.test b/tests/coroutine.test
index d248269..639fc0b 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.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: coroutine.test,v 1.8 2009/12/06 19:37:50 msofer Exp $
+# RCS: @(#) $Id: coroutine.test,v 1.9 2009/12/07 20:49:29 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -322,6 +322,24 @@ test coroutine-3.5 {info coroutine} -setup {
     rename a {}
     rename b {}
 } -result {}
+test coroutine-3.6 {info frame, bug #2910094} -setup {
+    proc stack {} {
+	set res [list "LEVEL:[set lev [info frame]]"]
+	for {set i 1} {$i < $lev} {incr i} {
+	    lappend res [info frame $i]
+	}
+	set res
+	# the precise command depends on line numbers and such, is likely not
+	# to be stable: just check that the test completes!
+	return
+    }
+    proc a {} stack
+} -body {
+    coroutine aa a
+} -cleanup {
+    rename stack {}
+    rename a {}
+} -result {}
 
 test coroutine-4.1 {bug #2093188} -setup {
     proc foo {} {