Tk Library Source Code

Artifact 036be24e179c438045bac6198b2af632192a5d0a:

Attachment "patch.diffs" to ticket [1861565fff] added by hemanglavana 2008-01-02 12:05:12.

---

Index: comm.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/comm/comm.tcl,v
retrieving revision 1.30
diff -u -p -w -r1.30 comm.tcl
--- comm.tcl    15 Aug 2007 21:33:37 -0000      1.30
+++ comm.tcl    2 Jan 2008 04:56:49 -0000
@@ -323,7 +323,8 @@ proc ::comm::comm_cmd_destroy {chan} {
     }
     set pos [lsearch -exact $comm(chans) $chan]
     set comm(chans) [lreplace $comm(chans) $pos $pos]
-    if {![string equal ::comm::comm $chan]} {
+    if {![string equal ::comm::comm $chan] &&
+        ![string equal [info proc $chan] ""]} {
        rename $chan {}
     }
     return
@@ -765,7 +766,8 @@ proc ::comm::commConfigure {chan {force 
        }
        if {[info exists userport] || ![string match "*already in use" $ret]} {
            # don't eradicate the class
-           if {![string equal ::comm::comm $chan]} {
+           if {![string equal ::comm::comm $chan] &&
+                ![string equal [info proc $chan] ""]} {
                rename $chan {}
            }
            return -code error $ret
Index: comm.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/comm/comm.test,v
retrieving revision 1.11
diff -u -p -w -r1.11 comm.test
--- comm.test   20 Aug 2007 23:07:05 -0000      1.11
+++ comm.test   2 Jan 2008 04:56:49 -0000
@@ -243,6 +243,16 @@ test comm-4.2 {async generation/receptio
     # B returned before A, A was sent before B
 } {{-result {delayed B}} {-result {delayed A}}}
 
+# ------------------------------------------------------------------------
+test comm-5.0 {-port already in use} {
+    # First start a server on port 12345
+    set port 12345
+    catch {set shdl [socket -server foo $port]}
+    catch {::comm::comm new bar -port $port -listen 1 -local 0} msg
+    catch {close $shdl}
+    unset -nocomplain shdl port
+    set msg
+} {couldn't open socket: address already in use}
 
 # ------------------------------------------------------------------------