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

diff --git a/ChangeLog b/ChangeLog
index 627d62db1f11a05061bb625beebe27aeb82ec6c0..77bdc628406d8b1b232bffde7fbd4cc1d1ac1112 100644 (file)
--- 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 8d8ed4d0f70f6ad4b1ccc87dc3ec8a3dfca4c661..d911ed5b9ee2561f9b22ba5c666259466ac08288 100644 (file)
--- 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 70331ae1c4295ca4934e55c3c296e177da5637d9..2f6cd79853e4b5898afee279da74423a95a8e7eb 100644 (file)
--- 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}