Tcl Source Code

Check-in [32d82f87bd]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:* tests/tests/socket.test: Changed so tests don't reuse sockets, since Windows is slow to release sockets.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 32d82f87bd3c8e566f3a103ed81398359f2b01d4
User & Date: stanton 1999-04-05 22:18:03
Context
1999-04-05
22:18
*** empty log message *** check-in: 3b3a73e766 user: stanton tags: core-8-1-branch-old
22:18
* tests/tests/socket.test: Changed so tests don't reuse sockets, since Windows is slow to release so... check-in: 32d82f87bd user: stanton tags: core-8-1-branch-old
21:58
* win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinSerial.c: Fixed race condition where backgrou... check-in: 9c78cc3ee2 user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to tests/socket.test.

     6      6   #
     7      7   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
     8      8   # Copyright (c) 1998-1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: socket.test,v 1.1.2.10 1999/03/25 01:25:14 redman Exp $
           13  +# RCS: @(#) $Id: socket.test,v 1.1.2.11 1999/04/05 22:18:03 stanton Exp $
    14     14   
    15     15   # Running socket tests with a remote server:
    16     16   # ------------------------------------------
    17     17   # 
    18     18   # Some tests in socket.test depend on the existence of a remote server to
    19     19   # which they connect. The remote server must be an instance of tcltest and it
    20     20   # must run the script found in the file "remote.tcl" in this directory. You
................................................................................
   280    280       set port [expr 2048 + [pid]%1024]
   281    281   }
   282    282   test socket-2.2 {tcp connection with client port specified} {socket stdio} {
   283    283       removeFile script
   284    284       set f [open script w]
   285    285       puts $f {
   286    286   	set timer [after 2000 "set x done"]
   287         -        set f [socket -server accept 2828]
          287  +        set f [socket -server accept 2829]
   288    288   	proc accept {file addr port} {
   289    289               global x
   290    290               puts "[gets $file] $port"
   291    291               close $file
   292    292               set x done
   293    293   	}
   294    294   	puts ready
................................................................................
   296    296   	after cancel $timer
   297    297   	close $f
   298    298       }
   299    299       close $f
   300    300       set f [open "|[list $tcltest script]" r]
   301    301       gets $f x
   302    302       global port
   303         -    if {[catch {socket -myport $port 127.0.0.1 2828} sock]} {
          303  +    if {[catch {socket -myport $port 127.0.0.1 2829} sock]} {
   304    304           set x $sock
   305         -	close [socket 127.0.0.1 2828]
          305  +	close [socket 127.0.0.1 2829]
   306    306   	puts stderr $sock
   307    307       } else {
   308    308           puts $sock hello
   309    309   	flush $sock
   310    310           lappend x [gets $f]
   311    311           close $sock
   312    312       }
................................................................................
   314    314       set x
   315    315   } [list ready "hello $port"]
   316    316   test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
   317    317       removeFile script
   318    318       set f [open script w]
   319    319       puts $f {
   320    320   	set timer [after 2000 "set x done"]
   321         -        set f [socket  -server accept 2828]
          321  +        set f [socket  -server accept 2830]
   322    322   	proc accept {file addr port} {
   323    323               global x
   324    324               puts "[gets $file] $addr"
   325    325               close $file
   326    326               set x done
   327    327   	}
   328    328   	puts ready
................................................................................
   329    329   	vwait x
   330    330   	after cancel $timer
   331    331   	close $f
   332    332       }
   333    333       close $f
   334    334       set f [open "|[list $tcltest script]" r]
   335    335       gets $f x
   336         -    if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2828} sock]} {
          336  +    if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
   337    337           set x $sock
   338    338       } else {
   339    339           puts $sock hello
   340    340   	flush $sock
   341    341           lappend x [gets $f]
   342    342           close $sock
   343    343       }
................................................................................
   345    345       set x
   346    346   } {ready {hello 127.0.0.1}}
   347    347   test socket-2.4 {tcp connection with server interface specified} {socket stdio} {
   348    348       removeFile script
   349    349       set f [open script w]
   350    350       puts $f {
   351    351   	set timer [after 2000 "set x done"]
   352         -        set f [socket -server accept -myaddr [info hostname] 2828]
          352  +        set f [socket -server accept -myaddr [info hostname] 2831]
   353    353   	proc accept {file addr port} {
   354    354               global x
   355    355               puts "[gets $file]"
   356    356               close $file
   357    357               set x done
   358    358   	}
   359    359   	puts ready
................................................................................
   360    360   	vwait x
   361    361   	after cancel $timer
   362    362   	close $f
   363    363       }
   364    364       close $f
   365    365       set f [open "|[list $tcltest script]" r]
   366    366       gets $f x
   367         -    if {[catch {socket [info hostname] 2828} sock]} {
          367  +    if {[catch {socket [info hostname] 2831} sock]} {
   368    368           set x $sock
   369    369       } else {
   370    370           puts $sock hello
   371    371   	flush $sock
   372    372           lappend x [gets $f]
   373    373           close $sock
   374    374       }
................................................................................
   376    376       set x
   377    377   } {ready hello}
   378    378   test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
   379    379       removeFile script
   380    380       set f [open script w]
   381    381       puts $f {
   382    382   	set timer [after 2000 "set x done"]
   383         -        set f [socket -server accept 2828]
          383  +        set f [socket -server accept 2832]
   384    384   	proc accept {file addr port} {
   385    385               global x
   386    386               puts "[gets $file]"
   387    387               close $file
   388    388               set x done
   389    389   	}
   390    390   	puts ready
................................................................................
   391    391   	vwait x
   392    392   	after cancel $timer
   393    393   	close $f
   394    394       }
   395    395       close $f
   396    396       set f [open "|[list $tcltest script]" r]
   397    397       gets $f x
   398         -    if {[catch {socket 127.0.0.1 2828} sock]} {
          398  +    if {[catch {socket 127.0.0.1 2832} sock]} {
   399    399           set x $sock
   400    400       } else {
   401    401           puts $sock hello
   402    402   	flush $sock
   403    403           lappend x [gets $f]
   404    404           close $sock
   405    405       }
   406    406       close $f
   407    407       set x
   408    408   } {ready hello}
   409    409   test socket-2.6 {tcp connection} {socket} {
   410    410       set status ok
   411         -    if {![catch {set sock [socket 127.0.0.1 2828]}]} {
          411  +    if {![catch {set sock [socket 127.0.0.1 2833]}]} {
   412    412   	if {![catch {gets $sock}]} {
   413    413   	    set status broken
   414    414   	}
   415    415   	close $sock
   416    416       }
   417    417       set status
   418    418   } ok
   419    419   test socket-2.7 {echo server, one line} {socket stdio} {
   420    420       removeFile script
   421    421       set f [open script w]
   422    422       puts $f {
   423    423   	set timer [after 2000 "set x done"]
   424         -	set f [socket -server accept 2828]
          424  +	set f [socket -server accept 2834]
   425    425   	proc accept {s a p} {
   426    426               fileevent $s readable [list echo $s]
   427    427   	    fconfigure $s -translation lf -buffering line
   428    428           }
   429    429   	proc echo {s} {
   430    430   	     set l [gets $s]
   431    431                if {[eof $s]} {
................................................................................
   441    441   	after cancel $timer
   442    442   	close $f
   443    443   	puts done
   444    444       }
   445    445       close $f
   446    446       set f [open "|[list $tcltest script]" r]
   447    447       gets $f
   448         -    set s [socket 127.0.0.1 2828]
          448  +    set s [socket 127.0.0.1 2834]
   449    449       fconfigure $s -buffering line -translation lf
   450    450       puts $s "hello abcdefghijklmnop"
   451    451       after 1000
   452    452       set x [gets $s]
   453    453       close $s
   454    454       set y [gets $f]
   455    455       close $f
   456    456       list $x $y
   457    457   } {{hello abcdefghijklmnop} done}
   458    458   test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
   459         -    removeFile script
   460         -    set f [open script w]
   461         -    puts $f {
   462         -	set f [socket -server accept 2828]
          459  +    makeFile {
          460  +	set f [socket -server accept 2835]
   463    461   	proc accept {s a p} {
   464    462               fileevent $s readable [list echo $s]
   465    463               fconfigure $s -buffering line
   466    464           }
   467    465   	proc echo {s} {
   468    466   	     global i
   469    467                set l [gets $s]
................................................................................
   479    477   	set i 0
   480    478   	puts ready
   481    479   	set timer [after 20000 "set x done"]
   482    480   	vwait x
   483    481   	after cancel $timer
   484    482   	close $f
   485    483   	puts "done $i"
   486         -    }
   487         -    close $f
          484  +    } script
   488    485       set f [open "|[list $tcltest script]" r]
   489    486       gets $f
   490         -    set s [socket 127.0.0.1 2828]
          487  +    set s [socket 127.0.0.1 2835]
   491    488       fconfigure $s -buffering line
   492    489       catch {
   493    490   	for {set x 0} {$x < 50} {incr x} {
   494    491   	    puts $s "hello abcdefghijklmnop"
   495    492   	    gets $s
   496    493   	}
   497    494       }