Tcl Source Code

OriginalBugID: 5946 Bug
Version: 8.3
SubmitDate: '2000-06-26'
LastModified: '2000-10-25'
Severity: MED
Status: UnAssn
Submitter: techsupp
OS: Linux-Red Hat
FixedDate: '2000-10-25'
ClosedDate: '2000-10-25'


Name:

Paul Duffin


Comments:

The patch only adds a constraint to prevent the tests from running, it

    does not make the tests clean themselves up. Also the initialisation of

    the constraint needs checking to see if it works on other platforms.


ReproducibleScript:

Run the Tcl test suite on a machine running which is disconnected from the network.


ObservedBehavior:

The networking tests are run and fail. These tests leave active sockets lying around which cause some of the later tests which check that the [vwait] command works properly to hang.


DesiredBehavior:

The networking tests should be skipped and even when they are run they should clean themselves up properly.


Patch:

Index: tcl/doc/tcltest.n

diff -c tcl/doc/tcltest.n:1.9 tcl/doc/tcltest.n:1.10

*** tcl/doc/tcltest.n:1.9Wed May 17 17:15:46 2000

--- tcl/doc/tcltest.nThu May 18 21:57:03 2000

***************

*** 285,294 ****

  .PP

  The following is a list of constraints defined in the \fBtcltest\fR package:

  .TP

! \fIunix\fR

  test can only be run on any UNIX platform

  .TP

! \fIpc\fR

  test can only be run on any Windows platform

  .TP

  \fInt\fR

--- 285,294 ----

  .PP

  The following is a list of constraints defined in the \fBtcltest\fR package:

  .TP

! \fIunix[Only]\fR

  test can only be run on any UNIX platform

  .TP

! \fIpc[Only]\fR

  test can only be run on any Windows platform

  .TP

  \fInt\fR

***************

*** 300,306 ****

  \fI98\fR

  test can only be run on any Windows 98 platform

  .TP

! \fImac\fR

  test can only be run on any Mac platform

  .TP

  \fIunixOrPc\fR

--- 300,306 ----

  \fI98\fR

  test can only be run on any Windows 98 platform

  .TP

! \fImac[Only]\fR

  test can only be run on any Mac platform

  .TP

  \fIunixOrPc\fR

***************

*** 385,390 ****

--- 385,396 ----

  .TP

  \fIstdio\fR

  test can only be run if the current app can be spawned via a pipe

+ .TP

+ \fIsocket\fR

+ test can only be run if the machine supports sockets

+ .TP

+ \fInetwork\fR

+ test can only be run if the machine is connected to the network

  .SH "RUNNING TEST FILES"

  Use the following command to run a test file that uses package

  tcltest:

Index: tcl/library/tcltest1.0/tcltest.tcl

diff -c tcl/library/tcltest1.0/tcltest.tcl:1.24 tcl/library/tcltest1.0/tcltest.tcl:1.25

*** tcl/library/tcltest1.0/tcltest.tcl:1.24Wed May 17 17:16:00 2000

--- tcl/library/tcltest1.0/tcltest.tclThu May 18 21:57:03 2000

***************

*** 442,447 ****

--- 442,448 ----


  proc ::tcltest::initConstraints {} {

      global tcl_platform tcl_interactive tk_version

+     global errorCode


      # The following trace procedure makes it so that we can safely refer to

      # non-existent members of the ::tcltest::testConstraints array without

***************

*** 683,689 ****

      catch {socket} msg

      set ::tcltest::testConstraints(socket) \

      [expr {$msg != "sockets are not available on this system"}]

!     

      # Check for internationalization


      if {[info commands testlocale] == ""} {

--- 684,711 ----

      catch {socket} msg

      set ::tcltest::testConstraints(socket) \

      [expr {$msg != "sockets are not available on this system"}]

! 

!     # If sockets are supported check that the network is actually connected.

! 

!     if { $::tcltest::testConstraints(socket) } {

! 

! # Assume that it is network.

! set ::tcltest::testConstraints(network) 1

! 

! set code [catch {socket [info hostname] 2000} sock]

! if { $code } {

!     set msg [lindex $errorCode 2]

!     if { [string compare $msg "network is unreachable"] == 0 } {

! set ::tcltest::testConstraints(network) 0

!     }

! } else {

!     close $sock

! }

! 

!     } else {

! set ::tcltest::testConstraints(network) 0

!     }

! 

      # Check for internationalization


      if {[info commands testlocale] == ""} {

Index: tcl/tests/http.test

diff -c tcl/tests/http.test:1.19 tcl/tests/http.test:1.20

*** tcl/tests/http.test:1.19Wed May 17 17:15:49 2000

--- tcl/tests/http.testThu May 18 21:57:03 2000

***************

*** 118,124 ****


  set url [info hostname]:$port

  set badurl www.scriptics.com:6666

! test http-3.3 {http::geturl} {

      set token [http::geturl $url]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 118,124 ----


  set url [info hostname]:$port

  set badurl www.scriptics.com:6666

! test http-3.3 {http::geturl} {network} {

      set token [http::geturl $url]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 132,138 ****

  set posturl [info hostname]:$port/post

  set badposturl [info hostname]:$port/droppost


! test http-3.4 {http::geturl} {

      set token [http::geturl $url]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 132,138 ----

  set posturl [info hostname]:$port/post

  set badposturl [info hostname]:$port/droppost


! test http-3.4 {http::geturl} {network} {

      set token [http::geturl $url]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 144,150 ****

      global port

      return [list [info hostname] $port]

  }

! test http-3.5 {http::geturl} {

      http::config -proxyfilter selfproxy

      set token [http::geturl $url]

      http::config -proxyfilter http::ProxyRequired

--- 144,150 ----

      global port

      return [list [info hostname] $port]

  }

! test http-3.5 {http::geturl} {network} {

      http::config -proxyfilter selfproxy

      set token [http::geturl $url]

      http::config -proxyfilter http::ProxyRequired

***************

*** 154,160 ****

  <h2>GET http://$url</h2>

  </body></html>"


! test http-3.6 {http::geturl} {

      http::config -proxyfilter bogus

      set token [http::geturl $url]

      http::config -proxyfilter http::ProxyRequired

--- 154,160 ----

  <h2>GET http://$url</h2>

  </body></html>"


! test http-3.6 {http::geturl} {network} {

      http::config -proxyfilter bogus

      set token [http::geturl $url]

      http::config -proxyfilter http::ProxyRequired

***************

*** 164,170 ****

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.7 {http::geturl} {

      set token [http::geturl $url -headers {Pragma no-cache}]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 164,170 ----

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.7 {http::geturl} {network} {

      set token [http::geturl $url -headers {Pragma no-cache}]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 172,178 ****

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.8 {http::geturl} {

      set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 172,178 ----

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.8 {http::geturl} {network} {

      set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]

      http::data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 185,196 ****

  </dl>

  </body></html>"


! test http-3.9 {http::geturl} {

      set token [http::geturl $url -validate 1]

      http::code $token

  } "HTTP/1.0 200 OK"


! test http-3.10 {http::geturl queryprogress} {

      set query foo=bar

      set sep ""

      set i 0

--- 185,196 ----

  </dl>

  </body></html>"


! test http-3.9 {http::geturl} {network} {

      set token [http::geturl $url -validate 1]

      http::code $token

  } "HTTP/1.0 200 OK"


! test http-3.10 {http::geturl queryprogress} {network} {

      set query foo=bar

      set sep ""

      set i 0

***************

*** 212,218 ****

      list [http::status $t] [string length $query] $postProgress [http::data $t]

  } {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}


! test http-3.11 {http::geturl querychannel with -command} {

      set query foo=bar

      set sep ""

      set i 0

--- 212,218 ----

      list [http::status $t] [string length $query] $postProgress [http::data $t]

  } {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}


! test http-3.11 {http::geturl querychannel with -command} {network} {

      set query foo=bar

      set sep ""

      set i 0

***************

*** 291,316 ****

  } {ok {HTTP/1.0 200 Data follows}}


! test http-4.1 {http::Event} {

      set token [http::geturl $url]

      upvar #0 $token data

      array set meta $data(meta)

      expr ($data(totalsize) == $meta(Content-Length))

  } 1


! test http-4.2 {http::Event} {

      set token [http::geturl $url]

      upvar #0 $token data

      array set meta $data(meta)

      string compare $data(type) [string trim $meta(Content-Type)]

  } 0


! test http-4.3 {http::Event} {

      set token [http::geturl $url]

      http::code $token

  } {HTTP/1.0 200 Data follows}


! test http-4.4 {http::Event} {

      set out [open testfile w]

      set token [http::geturl $url -channel $out]

      close $out

--- 291,316 ----

  } {ok {HTTP/1.0 200 Data follows}}


! test http-4.1 {http::Event} {network} {

      set token [http::geturl $url]

      upvar #0 $token data

      array set meta $data(meta)

      expr ($data(totalsize) == $meta(Content-Length))

  } 1


! test http-4.2 {http::Event} {network} {

      set token [http::geturl $url]

      upvar #0 $token data

      array set meta $data(meta)

      string compare $data(type) [string trim $meta(Content-Type)]

  } 0


! test http-4.3 {http::Event} {network} {

      set token [http::geturl $url]

      http::code $token

  } {HTTP/1.0 200 Data follows}


! test http-4.4 {http::Event} {network} {

      set out [open testfile w]

      set token [http::geturl $url -channel $out]

      close $out

***************

*** 324,330 ****

  <h2>GET $tail</h2>

  </body></html>"


! test http-4.5 {http::Event} {

      set out [open testfile w]

      set token [http::geturl $url -channel $out]

      close $out

--- 324,330 ----

  <h2>GET $tail</h2>

  </body></html>"


! test http-4.5 {http::Event} {network} {

      set out [open testfile w]

      set token [http::geturl $url -channel $out]

      close $out

***************

*** 333,339 ****

      expr $data(currentsize) == $data(totalsize)

  } 1


! test http-4.6 {http::Event} {

      set out [open testfile w]

      set token [http::geturl $binurl -channel $out]

      close $out

--- 333,339 ----

      expr $data(currentsize) == $data(totalsize)

  } 1


! test http-4.6 {http::Event} {network} {

      set out [open testfile w]

      set token [http::geturl $binurl -channel $out]

      close $out

***************

*** 360,378 ****

  set progress

      } {111 111}

  }

! test http-4.7 {http::Event} {

      set token [http::geturl $url -progress myProgress]

      set progress

  } {111 111}

! test http-4.8 {http::Event} {

      set token [http::geturl $url]

      http::status $token

  } {ok}

! test http-4.9 {http::Event} {

      set token [http::geturl $url -progress myProgress]

      http::code $token

  } {HTTP/1.0 200 Data follows}

! test http-4.10 {http::Event} {

      set token [http::geturl $url -progress myProgress]

      http::size $token

  } {111}

--- 360,378 ----

  set progress

      } {111 111}

  }

! test http-4.7 {http::Event} {network} {

      set token [http::geturl $url -progress myProgress]

      set progress

  } {111 111}

! test http-4.8 {http::Event} {network} {

      set token [http::geturl $url]

      http::status $token

  } {ok}

! test http-4.9 {http::Event} {network} {

      set token [http::geturl $url -progress myProgress]

      http::code $token

  } {HTTP/1.0 200 Data follows}

! test http-4.10 {http::Event} {network} {

      set token [http::geturl $url -progress myProgress]

      http::size $token

  } {111}

***************

*** 382,388 ****

  #Short timeout to working server  (the test server)

  #This lets us try a reset during the connection


! test http-4.11 {http::Event} {

      set token [http::geturl $url -timeout 1 -command {#}]

      http::reset $token

      http::status $token

--- 382,388 ----

  #Short timeout to working server  (the test server)

  #This lets us try a reset during the connection


! test http-4.11 {http::Event} {network} {

      set token [http::geturl $url -timeout 1 -command {#}]

      http::reset $token

      http::status $token

***************

*** 390,396 ****


  #Longer timeout with reset


! test http-4.12 {http::Event} {

      set token [http::geturl $url/?timeout=10 -command {#}]

      http::reset $token

      http::status $token

--- 390,396 ----


  #Longer timeout with reset


! test http-4.12 {http::Event} {network} {

      set token [http::geturl $url/?timeout=10 -command {#}]

      http::reset $token

      http::status $token

***************

*** 399,405 ****

  #Medium timeout to working server that waits even longer

  #The timeout hits while waiting for a reply


! test http-4.13 {http::Event} {

      set token [http::geturl $url?timeout=30 -timeout 10 -command {#}]

      http::wait $token

      http::status $token

--- 399,405 ----

  #Medium timeout to working server that waits even longer

  #The timeout hits while waiting for a reply


! test http-4.13 {http::Event} {network} {

      set token [http::geturl $url?timeout=30 -timeout 10 -command {#}]

      http::wait $token

      http::status $token

***************

*** 408,414 ****

  #Longer timeout to good host, bad port, gets an error

  #after the connection "completes" but the socket is bad


! test http-4.14 {http::Event} {

      set code [catch {

  set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}]

  if {[string length $token] == 0} {

--- 408,414 ----

  #Longer timeout to good host, bad port, gets an error

  #after the connection "completes" but the socket is bad


! test http-4.14 {http::Event} {network} {

      set code [catch {

  set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}]

  if {[string length $token] == 0} {

***************

*** 445,451 ****

      http::formatQuery lines "line1\nline2\nline3"

  } {lines=line1%0d%0aline2%0d%0aline3}


! test http-6.1 {http::ProxyRequired} {

      http::config -proxyhost [info hostname] -proxyport $port

      set token [http::geturl $url]

      http::wait $token

--- 445,451 ----

      http::formatQuery lines "line1\nline2\nline3"

  } {lines=line1%0d%0aline2%0d%0aline3}


! test http-6.1 {http::ProxyRequired} {network} {

      http::config -proxyhost [info hostname] -proxyport $port

      set token [http::geturl $url]

      http::wait $token

Index: tcl/tests/httpold.test

diff -c tcl/tests/httpold.test:1.8 tcl/tests/httpold.test:1.9

*** tcl/tests/httpold.test:1.8Wed May 17 17:15:41 2000

--- tcl/tests/httpold.testThu May 18 21:57:03 2000

***************

*** 87,93 ****

  } {Unsupported URL: http:junk}


  set url [info hostname]:$port

! test http-3.3 {http_get} {

      set token [http_get $url]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 87,93 ----

  } {Unsupported URL: http:junk}


  set url [info hostname]:$port

! test http-3.3 {http_get} {network} {

      set token [http_get $url]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 99,105 ****

  set url [info hostname]:$port/a/b/c

  set binurl [info hostname]:$port/binary


! test http-3.4 {http_get} {

      set token [http_get $url]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 99,105 ----

  set url [info hostname]:$port/a/b/c

  set binurl [info hostname]:$port/binary


! test http-3.4 {http_get} {network} {

      set token [http_get $url]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 111,117 ****

      global port

      return [list [info hostname] $port]

  }

! test http-3.5 {http_get} {

      http_config -proxyfilter selfproxy

      set token [http_get $url]

      http_config -proxyfilter httpProxyRequired

--- 111,117 ----

      global port

      return [list [info hostname] $port]

  }

! test http-3.5 {http_get} {network} {

      http_config -proxyfilter selfproxy

      set token [http_get $url]

      http_config -proxyfilter httpProxyRequired

***************

*** 121,127 ****

  <h2>GET http://$url</h2>

  </body></html>"


! test http-3.6 {http_get} {

      http_config -proxyfilter bogus

      set token [http_get $url]

      http_config -proxyfilter httpProxyRequired

--- 121,127 ----

  <h2>GET http://$url</h2>

  </body></html>"


! test http-3.6 {http_get} {network} {

      http_config -proxyfilter bogus

      set token [http_get $url]

      http_config -proxyfilter httpProxyRequired

***************

*** 131,137 ****

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.7 {http_get} {

      set token [http_get $url -headers {Pragma no-cache}]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 131,137 ----

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.7 {http_get} {network} {

      set token [http_get $url -headers {Pragma no-cache}]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 139,145 ****

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.8 {http_get} {

      set token [http_get $url -query Name=Value&Foo=Bar]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

--- 139,145 ----

  <h2>GET $tail</h2>

  </body></html>"


! test http-3.8 {http_get} {network} {

      set token [http_get $url -query Name=Value&Foo=Bar]

      http_data $token

  } "<html><head><title>HTTP/1.0 TEST</title></head><body>

***************

*** 152,183 ****

  </dl>

  </body></html>"


! test http-3.9 {http_get} {

      set token [http_get $url -validate 1]

      http_code $token

  } "HTTP/1.0 200 OK"


! test http-4.1 {httpEvent} {

      set token [http_get $url]

      upvar #0 $token data

      array set meta $data(meta)

      expr ($data(totalsize) == $meta(Content-Length))

  } 1


! test http-4.2 {httpEvent} {

      set token [http_get $url]

      upvar #0 $token data

      array set meta $data(meta)

      string compare $data(type) [string trim $meta(Content-Type)]

  } 0


! test http-4.3 {httpEvent} {

      set token [http_get $url]

      http_code $token

  } {HTTP/1.0 200 Data follows}


! test http-4.4 {httpEvent} {

      set out [open testfile w]

      set token [http_get $url -channel $out]

      close $out

--- 152,183 ----

  </dl>

  </body></html>"


! test http-3.9 {http_get} {network} {

      set token [http_get $url -validate 1]

      http_code $token

  } "HTTP/1.0 200 OK"


! test http-4.1 {httpEvent} {network} {

      set token [http_get $url]

      upvar #0 $token data

      array set meta $data(meta)

      expr ($data(totalsize) == $meta(Content-Length))

  } 1


! test http-4.2 {httpEvent} {network} {

      set token [http_get $url]

      upvar #0 $token data

      array set meta $data(meta)

      string compare $data(type) [string trim $meta(Content-Type)]

  } 0


! test http-4.3 {httpEvent} {network} {

      set token [http_get $url]

      http_code $token

  } {HTTP/1.0 200 Data follows}


! test http-4.4 {httpEvent} {network} {

      set out [open testfile w]

      set token [http_get $url -channel $out]

      close $out

***************

*** 191,197 ****

  <h2>GET $tail</h2>

  </body></html>"


! test http-4.5 {httpEvent} {

      set out [open testfile w]

      set token [http_get $url -channel $out]

      close $out

--- 191,197 ----

  <h2>GET $tail</h2>

  </body></html>"


! test http-4.5 {httpEvent} {network} {

      set out [open testfile w]

      set token [http_get $url -channel $out]

      close $out

***************

*** 200,206 ****

      expr $data(currentsize) == $data(totalsize)

  } 1


! test http-4.6 {httpEvent} {

      set out [open testfile w]

      set token [http_get $binurl -channel $out]

      close $out

--- 200,206 ----

      expr $data(currentsize) == $data(totalsize)

  } 1


! test http-4.6 {httpEvent} {network} {

      set out [open testfile w]

      set token [http_get $binurl -channel $out]

      close $out

***************

*** 227,254 ****

  set progress

      } {111 111}

  }

! test http-4.7 {httpEvent} {

      set token [http_get $url -progress myProgress]

      set progress

  } {111 111}

! test http-4.8 {httpEvent} {

      set token [http_get $url]

      http_status $token

  } {ok}

! test http-4.9 {httpEvent} {

      set token [http_get $url -progress myProgress]

      http_code $token

  } {HTTP/1.0 200 Data follows}

! test http-4.10 {httpEvent} {

      set token [http_get $url -progress myProgress]

      http_size $token

  } {111}

! test http-4.11 {httpEvent} {

      set token [http_get $url -timeout 1 -command {#}]

      http_reset $token

      http_status $token

  } {reset}

! test http-4.12 {httpEvent} {

      update

      set x {}

      after 500 {lappend x ok}

--- 227,254 ----

  set progress

      } {111 111}

  }

! test http-4.7 {httpEvent} {network} {

      set token [http_get $url -progress myProgress]

      set progress

  } {111 111}

! test http-4.8 {httpEvent} {network} {

      set token [http_get $url]

      http_status $token

  } {ok}

! test http-4.9 {httpEvent} {network} {

      set token [http_get $url -progress myProgress]

      http_code $token

  } {HTTP/1.0 200 Data follows}

! test http-4.10 {httpEvent} {network} {

      set token [http_get $url -progress myProgress]

      http_size $token

  } {111}

! test http-4.11 {httpEvent} {network} {

      set token [http_get $url -timeout 1 -command {#}]

      http_reset $token

      http_status $token

  } {reset}

! test http-4.12 {httpEvent} {network} {

      update

      set x {}

      after 500 {lappend x ok}

***************

*** 269,275 ****

      http_formatQuery lines "line1\nline2\nline3"

  } {lines=line1%0d%0aline2%0d%0aline3}


! test http-6.1 {httpProxyRequired} {

      update

      http_config -proxyhost [info hostname] -proxyport $port

      set token [http_get $url]

--- 269,275 ----

      http_formatQuery lines "line1\nline2\nline3"

  } {lines=line1%0d%0aline2%0d%0aline3}


! test http-6.1 {httpProxyRequired} {network} {

      update

      http_config -proxyhost [info hostname] -proxyport $port

      set token [http_get $url]

Index: tcl/tests/io.test

diff -c tcl/tests/io.test:1.14 tcl/tests/io.test:1.15

*** tcl/tests/io.test:1.14Wed May 17 17:15:20 2000

--- tcl/tests/io.testThu May 18 21:57:03 2000

***************

*** 2625,2631 ****

      close $f

      set r

  } "hello\nbye\nstrange\n"

! test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {

      set c 0

      set x running

      set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz

--- 2625,2631 ----

      close $f

      set r

  } "hello\nbye\nstrange\n"

! test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket network tempNotMac} {

      set c 0

      set x running

      set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz

***************

*** 2661,2667 ****

      vwait x

      set c

  } 2000

! test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac} {

      # On Mac, this test screws up sockets such that subsequent tests using port 2828 

      # either cause errors or panic().


--- 2661,2667 ----

      vwait x

      set c

  } 2000

! test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket network tempNotMac} {

      # On Mac, this test screws up sockets such that subsequent tests using port 2828 

      # either cause errors or panic().


***************

*** 6202,6208 ****

        {first after update}]

  } 0


! test io-51.1 {Test old socket deletion on Macintosh} {socket} {

      set x 0

      set result ""

      proc accept {s a p} {

--- 6202,6208 ----

        {first after update}]

  } 0


! test io-51.1 {Test old socket deletion on Macintosh} {socket network} {

      set x 0

      set result ""

      proc accept {s a p} {

***************

*** 6511,6517 ****

      set fcopyTestDone;# 0 for plain end of file

  } {0}


! test io-54.1 {Recursive channel events} {socket} {

      # This test checks to see if file events are delivered during recursive

      # event loops when there is buffered data on the channel.


--- 6511,6517 ----

      set fcopyTestDone;# 0 for plain end of file

  } {0}


! test io-54.1 {Recursive channel events} {socket network} {

      # This test checks to see if file events are delivered during recursive

      # event loops when there is buffered data on the channel.


Index: tcl/tests/socket.test

diff -c tcl/tests/socket.test:1.14 tcl/tests/socket.test:1.15

*** tcl/tests/socket.test:1.14Wed May 17 17:15:21 2000

--- tcl/tests/socket.testThu May 18 21:57:03 2000

***************

*** 345,351 ****

      close $f

      set x

  } {ready {hello 127.0.0.1}}

! test socket-2.4 {tcp connection with server interface specified} {socket stdio} {

      removeFile script

      set f [open script w]

      puts $f {

--- 345,351 ----

      close $f

      set x

  } {ready {hello 127.0.0.1}}

! test socket-2.4 {tcp connection with server interface specified} {socket stdio network} {

      removeFile script

      set f [open script w]

      puts $f {

***************

*** 514,520 ****

      while executing

  "socket -server accept 2828"

      (file "script" line 1)}}

! test socket-2.10 {close on accept, accepted socket lives} {socket} {

      set done 0

      set timer [after 20000 "set done timed_out"]

      set ss [socket -server accept 2830]

--- 514,520 ----

      while executing

  "socket -server accept 2828"

      (file "script" line 1)}}

! test socket-2.10 {close on accept, accepted socket lives} {socket network} {

      set done 0

      set timer [after 20000 "set done timed_out"]

      set ss [socket -server accept 2830]

***************

*** 825,831 ****

      update

      llength $l

  } 12

! test socket-7.4 {testing socket specific options} {socket} {

      set s [socket -server accept 2823]

      proc accept {s a p} {

  global x

--- 825,831 ----

      update

      llength $l

  } 12

! test socket-7.4 {testing socket specific options} {socket network} {

      set s [socket -server accept 2823]

      proc accept {s a p} {

  global x

***************

*** 858,864 ****

      lappend l [lindex $x 0] [lindex $x 2] [llength $x]

  } {127.0.0.1 2829 3}


! test socket-8.1 {testing -async flag on sockets} {socket} {

      # NOTE: This test may fail on some Solaris 2.4 systems. If it does,

      # check that you have these patches installed (using showrev -p):

      #

--- 858,864 ----

      lappend l [lindex $x 0] [lindex $x 2] [llength $x]

  } {127.0.0.1 2829 3}


! test socket-8.1 {testing -async flag on sockets} {socket network} {

      # NOTE: This test may fail on some Solaris 2.4 systems. If it does,

      # check that you have these patches installed (using showrev -p):

      #

***************

*** 888,894 ****

      set z

  } bye


! test socket-9.1 {testing spurious events} {socket} {

      set len 0

      set spurious 0

      set done 0

--- 888,894 ----

      set z

  } bye


! test socket-9.1 {testing spurious events} {socket network} {

      set len 0

      set spurious 0

      set done 0

***************

*** 920,926 ****

      close $s

      list $spurious $len

  } {0 50}

! test socket-9.2 {testing async write, fileevents, flush on close} {socket} {

      set firstblock ""

      for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}

      set secondblock ""

--- 920,926 ----

      close $s

      list $spurious $len

  } {0 50}

! test socket-9.2 {testing async write, fileevents, flush on close} {socket network} {

      set firstblock ""

      for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}

      set secondblock ""

***************

*** 968,974 ****

      close $l

      set count

  } 65566

! test socket-9.3 {testing EOF stickyness} {socket} {

      proc count_to_eof {s} {

  global count done timer

  set l [gets $s]

--- 968,974 ----

      close $l

      set count

  } 65566

! test socket-9.3 {testing EOF stickyness} {socket network} {

      proc count_to_eof {s} {

  global count done timer

  set l [gets $s]


PatchFiles:

doc/tcltest.n

    tcl/library/tcltest1.0/tcltest.tcl

    tcl/tests/http.test

    tcl/tests/httpold.test

    tcl/tests/io.test

    tcl/tests/socket.test

Logged In: YES 
user_id=75003

Checking various OS if they produce the same error message.
(Patch was made on Linux, message is ok)
Solaris 2.6: Ok.

File Added - 9956: 219366.diff

Logged In: YES 
user_id=75003

Extracted the patch from the report and placed it into a 
file. Refitted it to the CVS head too.

Logged In: YES 
user_id=75003

Paul Duffin's current address is
<[email protected]>

The failure does not necessarily mean that sockets are not supported. On my system I have dial-on-demand, i.e the link to my provider is powered up whenever I access something outside of my own system. But I can disable the responsible demon, thus cutting off all applications from access to the net. This may cause the same problems. On another tack, executing the tcl testsuite means that I get connected to the net (the badurl tests) even if I don't want this.

The failure does not necessarily mean that sockets are not supported. On my system I have dial-on-demand, i.e the link to my provider is powered up whenever I access something outside of my own system. But I can disable the responsible demon, thus cutting off all applications from access to the net. This may cause the same problems. On another tack, executing the tcl testsuite means that I get connected to the net (the badurl tests) even if I don't want this.

Seems good to me, though why a Linux system would not support sockets?!  I could believe it of Windows, but...