From: patthoyts <patthoyts>
Date: Sun, 6 Jul 2008 12:27:30 +0000 (+0000)
Subject: Applied patch #1838467 (marttj) to avoid a crash when exiting with an open mcast... 
X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=b5f11287fd21af818979d4dd23f0d21abfac1a83;p=tcludp

Applied patch #1838467 (marttj) to avoid a crash when exiting with an open mcast socket.
---

diff --git a/ChangeLog b/ChangeLog
index 627d62d..77bdc62 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,13 +1,16 @@
 2008-07-06  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
-	* generic/udp_tcl.c: Applied patch #1838459 to properly handle
-	* tests/udp.test:    appending to a shared list object in 
+	* generic/udp_tcl.c: Applied patch #1838467 (marttj) to avoid a crash
+	* tests/udp.test:    when exiting with an open mcast socket.
+
+	* generic/udp_tcl.c: Applied patch #1838459 (marttj) to properly
+	* tests/udp.test:    handle appending to a shared list object in 
 	                     -mcastadd. Added tests.
 
 2008-07-05  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
-	* generic/udp_tcl.c: Applied patch 1848365 to accept any boolean
-	value for the -mcastloop option (plus tests).
+	* generic/udp_tcl.c: Applied patch 1848365 (marttj) to accept any
+	* tests/udp.test:    boolean value for -mcastloop (plus tests).
 
 2007-04-10  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
diff --git a/generic/udp_tcl.c b/generic/udp_tcl.c
index 8d8ed4d..d911ed5 100644
--- a/generic/udp_tcl.c
+++ b/generic/udp_tcl.c
@@ -890,11 +890,14 @@ udpClose(ClientData instanceData, Tcl_Interp *interp)
      */
     if (statePtr->groupsObj) {
 	int n = 0;
-	Tcl_ListObjGetElements(interp, statePtr->groupsObj, &objc, &objv);
+	Tcl_Obj *dupGroupList = Tcl_DuplicateObj(statePtr->groupsObj);
+	Tcl_IncrRefCount(dupGroupList);
+	Tcl_ListObjGetElements(interp, dupGroupList, &objc, &objv);
 	for (n = 0; n < objc; n++) {
 	    UdpMulticast((ClientData)statePtr, interp, 
 		Tcl_GetString(objv[n]), IP_DROP_MEMBERSHIP);
 	}
+	Tcl_DecrRefCount(dupGroupList);
 	Tcl_DecrRefCount(statePtr->groupsObj);
     }
     
@@ -1194,7 +1197,9 @@ UdpMulticast(ClientData instanceData, Tcl_Interp *interp,
     if (mreq.imr_multiaddr.s_addr == -1) {
         name = gethostbyname(grp);
         if (name == NULL) {
-            Tcl_SetResult(interp, "invalid group name", TCL_STATIC);
+	    if (interp != NULL) {
+		Tcl_SetResult(interp, "invalid group name", TCL_STATIC);
+	    }
             return TCL_ERROR;
         }
         memcpy(&mreq.imr_multiaddr.s_addr, name->h_addr,
@@ -1203,7 +1208,9 @@ UdpMulticast(ClientData instanceData, Tcl_Interp *interp,
     mreq.imr_interface.s_addr = INADDR_ANY;
     if (setsockopt(statePtr->sock, IPPROTO_IP, action,
                    (const char*)&mreq, sizeof(mreq)) < 0) {
-        Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group"));
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group"));
+	    }
         return TCL_ERROR;
     }
 
diff --git a/tests/udp.test b/tests/udp.test
index 70331ae..2f6cd79 100644
--- a/tests/udp.test
+++ b/tests/udp.test
@@ -20,32 +20,35 @@ package require udp
 
 # -------------------------------------------------------------------------
 
-test udp-1.0 {udp_open with any port} {
-    global _udp
-    list [catch {
-        set _udp [udp_open]
-        regexp {sock\d+} $_udp } msg] $msg
-} {0 1}
-
-test udp-1.1 {udp_conf -myport} {
-    global _udp
-    list [catch {string is integer [udp_conf $_udp -myport]} msg] $msg
-} {0 1}
-
-test udp_1.3 {close udp socket} {
-    global _udp
-    list [catch {close $_udp} msg] $msg
-} {0 {}}
+test udp-1.0 {udp_open with any port} -body {
+    set s [udp_open]
+} -cleanup {
+    close $s
+} -match regexp -result {sock\d+}
 
-test udp-1.4 {udp_open on assigned port} {
-    list [catch {
-        set port 0xf0b0
-        set s [udp_open $port]
-        set check [udp_conf $s -myport]
-        close $s
-        format 0x%04x $check
-    } msg] $msg
-} {0 0xf0b0}
+test udp-1.1 {udp_conf -myport} -setup {
+    set s [udp_open]
+} -body {
+    udp_conf $s -myport
+} -cleanup {
+    close $s
+} -match regexp -result {^\d+$}
+
+test udp_1.3 {fconfigure -myport} -setup {
+    set s [udp_open]
+} -body {
+    fconfigure $s -myport
+} -cleanup {
+    close $s
+} -match regexp -result {^\d+$}
+
+test udp-1.4 {udp_open on assigned port} -body {
+    set port 0xf0b0
+    set s [udp_open $port]
+    format 0x%04x [udp_conf $s -myport]
+} -cleanup {
+    close $s
+} -result {0xf0b0}
 
 test udp-1.5 {udp_conf -remote before seting remote details} {
     list [catch {
@@ -203,6 +206,20 @@ test udp-3.11 {-mcastloop is boolean - on/off} -setup {
     close $s
 } -result {1 0}
 
+
+
+test udp-10.1 "bug #1838467 - crash on exit" -setup {
+    set s [udp_open]
+} -body {
+    # Note: this test actually causes a crash on process exit when it
+    # fails. The socket needs to be left open ...
+    fconfigure $s -mcastadd 224.0.10.10
+    fconfigure $s -mcastadd 224.0.10.11
+    fconfigure $s -mcastadd 224.0.10.12
+} -cleanup {
+    # close $s - not closed on purpose
+} -result {224.0.10.10 224.0.10.11 224.0.10.12}
+
 # -------------------------------------------------------------------------
 # cleanup
 catch {unset _udp}