* generic/tclIORTrans.c (ReflectInput, ReflectOutput,

	ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree
	calls for preserved ReflectedTransform* structures. Reworked
	ReflectInput to preserve the structure for its whole life, not
	only in InvokeTclMethod.

	* generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate
	topChan, may have been changed by a self-modifying transformation.

	* tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11,
	iortrans-7.4, iortrans-8.3): New test cases.

1 files changed, 91 insertions, 2 deletions

diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index d26789c..7399bfb 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: ioTrans.test,v 1.7 2008/07/21 21:12:49 ferrieux Exp $
+# RCS: @(#) $Id: ioTrans.test,v 1.8 2010/03/17 16:35:42 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -41,6 +41,7 @@ set helperscript {
     }
 
     proc note  {item}  {global res; lappend res $item; return}
+    #proc note  {item}  {global res; lappend res $item; puts $item ; flush stdout ; return}
     proc track {}      {upvar args item; note $item; return}
     proc notes {items} {foreach i $items {note $i}}
 
@@ -452,7 +453,41 @@ test iortrans-4.7 {chan read, level is squashed} -match glob -body {
     set res
 } -result {{read rt* {test data
 }} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
-
+test iortrans-4.8 {chan read, read, bug 2921116} -match glob -setup {
+    set res {}
+    proc foo {fd args} {
+	oninit; onfinal; track
+	# Kill and recreate transform while it is operating
+	chan pop  $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+} -body {
+    note [read $c]
+    #note [gets $c]
+    set res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} file*}
+test iortrans-4.9 {chan read, gets, bug 2921116} -match glob -setup {
+    set res {}
+    proc foo {fd args} {
+	oninit; onfinal; track
+	# Kill and recreate transform while it is operating
+	chan pop  $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+} -body {
+    note [gets $c]
+    set res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} file*}
 
 # --- === *** ###########################
 # method write (via puts)
@@ -560,6 +595,28 @@ test iortrans-5.10 {chan write, failed write, level is ignored} -match glob -bod
     rename foo {}
     set res
 } -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}}
+test iortrans-5.11 {chan write, bug 2921116} -match glob -setup {
+    set res {}
+    set level 0
+    proc foo {fd args} {
+	oninit; onfinal; track
+	# pop - invokes flush - invokes 'foo write' - infinite recursion - stop it
+	global level
+	if {$level} { return "" }
+	incr level
+	# Kill and recreate transform while it is operating
+	chan pop  $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+} -body {
+    note [puts -nonewline $c abcdef]
+    note [flush $c]
+    set res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{} {write rt* abcdef} {write rt* abcdef} {}}
 
 # --- === *** ###########################
 # method limit?, drain (via read)
@@ -631,6 +688,22 @@ test iortrans-7.3 {clear, any result is ignored} -match glob -body {
     rename foo {}
     set res
 } -result {{clear rt*}}
+test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup {
+    set res {}
+    proc foo {fd args} {
+	oninit clear; onfinal; track
+	# Kill and recreate transform while it is operating
+	chan pop  $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+} -body {
+    seek $c 2
+    set res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*}}
 
 # --- === *** ###########################
 # method flush (via seek, close)
@@ -666,6 +739,22 @@ test iortrans-8.2 {close flushes write buffers, writes data} -match glob -body {
     set res
 } -result {{flush rt*} {finalize rt*} .flushed.}
 
+test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
+    set res {}
+    proc foo {fd args} {
+	oninit flush; onfinal; track
+	# Kill and recreate transform while it is operating
+	chan pop  $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+} -body {
+    seek $c 2
+    set res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{flush rt*}}
 
 # --- === *** ###########################
 # method watch - removed from TIP (rev 1.12+)