Applied patch #1838459 to properly handle appending to a shared list object in -mcast...

diff --git a/ChangeLog b/ChangeLog
index 1fd4ab6de8b0a6cfd5b92aec2c16b43a2d8d1142..627d62db1f11a05061bb625beebe27aeb82ec6c0 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+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 
+                            -mcastadd. Added tests.
+
 2008-07-05  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
        * generic/udp_tcl.c: Applied patch 1848365 to accept any boolean

diff --git a/generic/udp_tcl.c b/generic/udp_tcl.c
index 4719097adfc93054deef1517bff07f83ff5d250d..8d8ed4d0f70f6ad4b1ccc87dc3ec8a3dfca4c661 100644 (file)
--- a/generic/udp_tcl.c
+++ b/generic/udp_tcl.c
@@ -1210,7 +1210,14 @@ UdpMulticast(ClientData instanceData, Tcl_Interp *interp,
     if (action == IP_ADD_MEMBERSHIP) {
        int ndx = LSearch(statePtr->groupsObj, grp);
        if (ndx == -1) {
+           Tcl_Obj *newPtr;
            statePtr->multicast++;
+           if (Tcl_IsShared(statePtr->groupsObj)) {
+               newPtr = Tcl_DuplicateObj(statePtr->groupsObj);
+               Tcl_DecrRefCount(statePtr->groupsObj);
+               Tcl_IncrRefCount(newPtr);
+               statePtr->groupsObj = newPtr;
+           }
            Tcl_ListObjAppendElement(interp, statePtr->groupsObj,
                                     Tcl_NewStringObj(grp,-1));
        }

diff --git a/tests/udp.test b/tests/udp.test
index 6b81945b589cb3412674b63297d29b258c0f4fd4..70331ae1c4295ca4934e55c3c296e177da5637d9 100644 (file)
--- a/tests/udp.test
+++ b/tests/udp.test
@@ -94,24 +94,114 @@ test udp-2.2 {udp_open on named port} {pcOnly} {
     } msg] $msg
 } {0 0x007b}
 
-test udp-3.8 {multicastloop can be set to true} \
-    -body {
-       set s [udp_open]
-       fconfigure $s -mcastloop "true"
-       fconfigure $s -mcastloop
-    } -result {1} -cleanup {
-       close $s
-    }
-
-test udp-3.9 {multicastloop can be set to false} \
-    -body {
-       set s [udp_open]
-       fconfigure $s -mcastloop "true"
-       fconfigure $s -mcastloop "no"
-       fconfigure $s -mcastloop
-    } -result {0} -cleanup {
-       close $s
-    }
+test udp-3.0 {test -mcastadd} -setup {
+    set s [udp_open]
+} -body {
+    fconfigure $s -mcastadd 224.0.10.10
+} -cleanup {
+    close $s
+} -result {224.0.10.10}
+
+test udp-3.1 {test -mcastadd} -setup {
+    set s [udp_open]
+} -body {
+    fconfigure $s -mcastadd 224.0.10.10
+    fconfigure $s -mcastadd 224.0.10.11
+} -cleanup {
+    close $s
+} -result {224.0.10.10 224.0.10.11}
+
+test udp-3.2 {test -mcastadd} -setup {
+    set s [udp_open]
+} -body {
+    set a [fconfigure $s -mcastadd 224.0.10.10]
+    set a [fconfigure $s -mcastadd 224.0.10.11]
+} -cleanup {
+    close $s
+} -result {224.0.10.10 224.0.10.11}
+
+test udp-3.3 {test -mcastdrop} -setup {
+    set s [udp_open]
+} -body {
+    fconfigure $s -mcastadd 224.0.10.10
+    fconfigure $s -mcastadd 224.0.10.11
+    fconfigure $s -mcastdrop 224.0.10.11
+} -cleanup {
+    close $s
+} -result {224.0.10.10}
+
+test udp-3.4 {test -mcastdrop} -setup {
+    set s [udp_open]
+} -body {
+    set a [fconfigure $s -mcastadd 224.0.10.10]
+    set a [fconfigure $s -mcastadd 224.0.10.11]
+    set a [fconfigure $s -mcastdrop 224.0.10.11]
+} -cleanup {
+    close $s
+} -result {224.0.10.10}
+
+test udp-3.5 {join invalid multicast group} -setup {
+    set s [udp_open]
+} -body {
+    fconfigure $s -mcastadd 192.168.0.1
+} -cleanup {
+    close $s
+} -returnCodes error -match glob -result {*}
+
+test udp-3.6 {drop invalid multicast group} -setup {
+    set s [udp_open]
+} -body {
+    fconfigure $s -mcastdrop 192.168.0.1
+} -cleanup {
+    close $s
+} -returnCodes error -match glob -result {*}
+
+test udp-3.7 {-mcastloop invalid option} -setup {
+    set s [udp_open]
+} -body {
+    fconfigure $s -mcastloop stupid
+} -cleanup {
+    close $s
+} -returnCodes error -match glob -result {expected boolean value *}
+
+test udp-3.8 {-mcastloop is boolean - 1/0} -setup {
+    set s [udp_open]
+} -body {
+    set a [list [fconfigure $s -mcastloop 1]]
+    lappend a [fconfigure $s -mcastloop 0]
+    set a
+} -cleanup {
+    close $s
+} -result {1 0}
+
+test udp-3.9 {-mcastloop is boolean - true/false} -setup {
+    set s [udp_open]
+} -body {
+    set a [list [fconfigure $s -mcastloop true]]
+    lappend a [fconfigure $s -mcastloop false]
+    set a
+} -cleanup {
+    close $s
+} -result {1 0}
+
+test udp-3.10 {-mcastloop is boolean - yes/no} -setup {
+    set s [udp_open]
+} -body {
+    set a [list [fconfigure $s -mcastloop yes]]
+    lappend a [fconfigure $s -mcastloop no]
+    set a
+} -cleanup {
+    close $s
+} -result {1 0}
+
+test udp-3.11 {-mcastloop is boolean - on/off} -setup {
+    set s [udp_open]
+} -body {
+    set a [list [fconfigure $s -mcastloop on]]
+    lappend a [fconfigure $s -mcastloop off]
+} -cleanup {
+    close $s
+} -result {1 0}
 
 # -------------------------------------------------------------------------
 # cleanup