From 2c66fc643c1e662526ad4cd59b0b1836b171a35c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 12 Aug 2015 16:37:28 +0000
Subject: New test io-53.18 adapted from demo script in [32ae34e63a].  This
 test segfaults without changes to source code.  This checkin also contains a
 revised implementationf of [chan postevent] that stops calling
 Tcl_NotifyChannel() directly, and queues an event to do it instead. This
 stops the segfault, but causes tests iocmd-31.[67] to fail. Need advice on
 whether that matters.

---
 generic/tclIORChan.c | 26 +++++++++++++++++++++-
 tests/io.test        | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+), 1 deletion(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index bbb5b88..6592f9e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -741,6 +741,24 @@ TclChanCreateObjCmd(
  *----------------------------------------------------------------------
  */
 
+typedef struct PostEvent {
+    Tcl_Event event;		/* Basic event data, has to be first item */
+    Tcl_Channel chan;
+    int events;
+} PostEvent;
+
+static int
+CallNotify(
+    Tcl_Event *evPtr,
+    int flags)
+{
+    PostEvent *pevPtr = (PostEvent *)evPtr;
+
+    Tcl_NotifyChannel(pevPtr->chan, pevPtr->events);
+    TclChannelRelease(pevPtr->chan);
+    return 1;
+}
+
 int
 TclChanPostEventObjCmd(
     ClientData clientData,
@@ -769,6 +787,7 @@ TclChanPostEventObjCmd(
     int events;			/* Mask of events to post */
     ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
     Tcl_HashEntry* hPtr;         /* Entry in the above map */
+    PostEvent *pevPtr;
 
     /*
      * Number of arguments...
@@ -857,7 +876,12 @@ TclChanPostEventObjCmd(
      * We have the channel and the events to post.
      */
 
-    Tcl_NotifyChannel(chan, events);
+    pevPtr = (PostEvent *)ckalloc(sizeof(PostEvent));
+    pevPtr->event.proc = CallNotify;
+    pevPtr->chan = chan;
+    pevPtr->events = events;
+    TclChannelPreserve(chan);
+    Tcl_QueueEvent((Tcl_Event *)pevPtr, TCL_QUEUE_HEAD);
 
     /*
      * Squash interp results left by the event script.
diff --git a/tests/io.test b/tests/io.test
index 50c5808..46e3f05 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7886,6 +7886,68 @@ test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup {
     removeFile out
 } -result 100
 
+test io-53.18 {[32ae34e63a] recursize CopyData} -setup {
+    proc driver {cmd args} {
+        variable buffer
+        variable index
+        set chan [lindex $args 0]
+        switch -- $cmd {
+            initialize {
+                set index($chan) 0
+                set buffer($chan) [encoding convertto utf-8 \
+                        [string repeat a 100]]
+                return {initialize finalize watch read}
+            }
+            finalize {
+                unset index($chan) buffer($chan)
+                return
+            }
+            watch {
+                if {"read" in [lindex $args 1]} {
+                    chan postevent $chan read
+                }
+                return
+            }
+            read {
+                set n [lindex $args 1]
+                set new [expr {$index($chan) + $n}]
+                set result [string range $buffer($chan) $index($chan) $new-1]
+                set index($chan) $new
+                return $result
+            }
+        }
+    }
+    proc more {c outChan bytes args} {
+        if {[eof $c]} {
+            set ::done eof
+            catch {close $c}
+            return
+        }
+        if {[llength $args]} {
+            set ::done error
+        } else  {
+            chan copy $c $outChan -command [list [namespace which more] $c $outChan]
+        }
+    }
+    set c [chan create read [namespace which driver]]
+    chan configure $c -encoding utf-8
+    set out [makeFile {} out]
+    set outChan [open $out w]
+    # Different encoding to force use of DoReadChars()
+    chan configure $outChan -encoding iso8859-1
+} -body {
+    after 2000 {set ::done timeout}
+    chan copy $c $outChan -size 99 -command [list [namespace which more] $c $outChan]
+    vwait ::done
+    set ::done
+} -cleanup {
+    close $outChan
+    removeFile out
+    rename driver {}
+    rename more {}
+    unset ::done
+} -result eof
+
 test io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive
     # event loops when there is buffered data on the channel.
-- 
cgit v0.12