From 894848a9f5e409bcfc5d37c3214b02c5abb36907 Mon Sep 17 00:00:00 2001
From: patthoyts <patthoyts>
Date: Wed, 27 Apr 2005 08:11:08 +0000
Subject: [PATCH] 	* demos/bug1158628.tcl: Demo file for this bug. 
 * generic/udp_tcl.c: Applied a fix for bug #1158628 from Reinhard 	Max
 which avoids hanging Tcl while exiting with open channels. 	*
 configure.in:     Moved version to 1.0.7 	* win/makefile.vc:

---
 ChangeLog            |  8 ++++++
 configure            |  2 +-
 configure.in         |  2 +-
 demos/bug1158628.tcl | 61 ++++++++++++++++++++++++++++++++++++++++++++
 generic/udp_tcl.c    |  4 ++-
 win/makefile.vc      |  2 +-
 6 files changed, 75 insertions(+), 4 deletions(-)
 create mode 100644 demos/bug1158628.tcl

diff --git a/ChangeLog b/ChangeLog
index e46f693..405c634 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2005-04-27  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* demos/bug1158628.tcl: Demo file for this bug.
+	* generic/udp_tcl.c: Applied a fix for bug #1158628 from Reinhard
+	Max which avoids hanging Tcl while exiting with open channels.
+	* configure.in:     Moved version to 1.0.7
+	* win/makefile.vc: 
+
 2004-11-23  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
 	* demos/chat.tcl: Sample Tk chat app using multicast udp.
diff --git a/configure b/configure
index db9c7e2..9092875 100755
--- a/configure
+++ b/configure
@@ -573,7 +573,7 @@ PACKAGE=udp
 
 MAJOR_VERSION=1
 MINOR_VERSION=0
-PATCHLEVEL=6
+PATCHLEVEL=7
 
 VERSION=${MAJOR_VERSION}.${MINOR_VERSION}.${PATCHLEVEL}
 NODOT_VERSION=${MAJOR_VERSION}${MINOR_VERSION}
diff --git a/configure.in b/configure.in
index 4355ec6..1d7c290 100644
--- a/configure.in
+++ b/configure.in
@@ -39,7 +39,7 @@ PACKAGE=udp
 
 MAJOR_VERSION=1
 MINOR_VERSION=0
-PATCHLEVEL=6
+PATCHLEVEL=7
 
 VERSION=${MAJOR_VERSION}.${MINOR_VERSION}.${PATCHLEVEL}
 NODOT_VERSION=${MAJOR_VERSION}${MINOR_VERSION}
diff --git a/demos/bug1158628.tcl b/demos/bug1158628.tcl
new file mode 100644
index 0000000..e86837e
--- /dev/null
+++ b/demos/bug1158628.tcl
@@ -0,0 +1,61 @@
+# bug1158628.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sf.net>
+#
+# "On windows XP, I have a GUI that has an exit buttons which when
+# pressed does: {set done 1; destroy .;exit} If there is an open UDP
+# channel with a fileevent on it, the program will not exit --
+# i.e. task manager still shows it. Also if I have the console up, the
+# console goes away when the exit button is invoked, but the program
+# does not exit.  NOTE -- all windows are correctly destroyed (or at
+# least withdrawn)"
+#
+# The fault is calling Tcl_UnregisterChannel in the udpClose function.
+# We must let tcl handle this itself. Solved by Reinhard Max.
+#
+# This script demonstrates the problem. Using udp 1.0.6 the program hangs
+# after printing "Exiting...". With the fix applied it properly exits.
+#
+# $Id$
+
+If the channel is closed, the program will exit.
+
+BTW, when it will not exit it does *not* consume CPU
+resources.
+
+
+
+load [file join [file dirname [info script]] .. win Release udp106.dll]
+package require udp
+
+variable forever 0
+
+proc Event {sock} {
+    variable forever
+    set pkt [read $sock]
+    set peer [fconfigure $sock -peer]
+    puts "Recieved [string length $pkt] from $peer\n$pkt"
+    #set forever 1
+    return
+}
+
+proc Listen {port} {
+    set s [udp_open $port]
+    fconfigure $s -blocking 0 -buffering none -translation binary
+    fileevent $s readable [list Event $s]
+    return $s
+}
+
+proc Exit {sock} {
+    puts "Exiting"
+    exit 0
+}
+
+if {!$tcl_interactive} {
+    puts "Bug #1158628 - hangs in exit if open udp channels"
+    puts "  Using a buggy version, this will hang after printing Exiting..."
+    puts ""
+    set sock [Listen 10245]
+    puts "Wait 1 sec..."
+    after 1000 [list Exit $sock]
+    vwait forever
+    close $sock
+}
diff --git a/generic/udp_tcl.c b/generic/udp_tcl.c
index 63a6ccf..d76d20a 100644
--- a/generic/udp_tcl.c
+++ b/generic/udp_tcl.c
@@ -837,7 +837,9 @@ udpClose(ClientData instanceData, Tcl_Interp *interp)
 	Tcl_DecrRefCount(statePtr->groupsObj);
     }
     
-    Tcl_UnregisterChannel(interp, statePtr->channel);
+    /* No - doing this causes a infinite recursion. Let Tcl handle this.
+     *   Tcl_UnregisterChannel(interp, statePtr->channel);
+     */
     if (closesocket(sock) < 0) {
         errorCode = errno;
     }
diff --git a/win/makefile.vc b/win/makefile.vc
index 2e91178..fe16a13 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -156,7 +156,7 @@ Please `cd` to its location first.
 PROJECT = udp
 !include "rules.vc"
 
-DOTVERSION      = 1.0.6
+DOTVERSION      = 1.0.7
 VERSION         = $(DOTVERSION:.=)
 STUBPREFIX      = $(PROJECT)stub
 
-- 
2.23.0