# Commands tested in this file: socket.

#

# This file contains a collection of tests for one or more of the Tcl

# built-in commands.  Sourcing this file into Tcl runs the tests and

# generates output for errors.  No output means no errors were found.

#

# Copyright (c) 1994-1996 Sun Microsystems, Inc.

# Copyright (c) 1998-2000 Ajuba Solutions.

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

# RCS: @(#) $Id: socket.test,v 1.26.2.6 2006/03/16 00:35:59 andreas_kupries Exp $

# Running socket tests with a remote server:

# ------------------------------------------

# 

# Some tests in socket.test depend on the existence of a remote server to

# which they connect. The remote server must be an instance of tcltest and it

# must run the script found in the file "remote.tcl" in this directory. You

# can start the remote server on any machine reachable from the machine on

# which you want to run the socket tests, by issuing:

# 

#     tcltest remote.tcl -port 2048	# Or choose another port number.

# 

# If the machine you are running the remote server on has several IP

# interfaces, you can choose which interface the server listens on for

# connections by specifying the -address command line flag, so:

# 

#     tcltest remote.tcl -address your.machine.com

# 

# These options can also be set by environment variables. On Unix, you can

# type these commands to the shell from which the remote server is started:

# 

#     shell% setenv serverPort 2048

#     shell% setenv serverAddress your.machine.com

# 

# and subsequently you can start the remote server with:

# 

#     tcltest remote.tcl

# 

# to have it listen on port 2048 on the interface your.machine.com.

#     

# When the server starts, it prints out a detailed message containing its

# configuration information, and it will block until killed with a Ctrl-C.

# Once the remote server exists, you can run the tests in socket.test with

# the server by setting two Tcl variables:

# 

#     % set remoteServerIP <name or address of machine on which server runs>

#     % set remoteServerPort 2048

# 

# These variables are also settable from the environment. On Unix, you can:

# 

#     shell% setenv remoteServerIP machine.where.server.runs

#     shell% senetv remoteServerPort 2048

# 

# The preamble of the socket.test file checks to see if the variables are set

# either in Tcl or in the environment; if they are, it attempts to connect to

# the server. If the connection is successful, the tests using the remote

# server will be performed; otherwise, it will attempt to start the remote

# server (via exec) on platforms that support this, on the local host,

# listening at port 2048. If all fails, a message is printed and the tests

# using the remote server are not performed.

package require tcltest 2

namespace import -force ::tcltest::*

# Some tests require the testthread and exec commands

testConstraint testthread [llength [info commands testthread]]

testConstraint exec [llength [info commands exec]]

# If remoteServerIP or remoteServerPort are not set, check in the

# environment variables for externally set values.

#

if {![info exists remoteServerIP]} {

    if {[info exists env(remoteServerIP)]} {

	set remoteServerIP $env(remoteServerIP)

    }

}

if {![info exists remoteServerPort]} {

    if {[info exists env(remoteServerIP)]} {

	set remoteServerPort $env(remoteServerPort)

    } else {

        if {[info exists remoteServerIP]} {

	    set remoteServerPort 2048

        }

    }

}

#

# Check if we're supposed to do tests against the remote server

#

set doTestsWithRemoteServer 1

if {![info exists remoteServerIP] && ($tcl_platform(platform) != "macintosh")} {

    set remoteServerIP 127.0.0.1

}

if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {

    set remoteServerPort 2048

}

# Attempt to connect to a remote server if one is already running. If it

# is not running or for some other reason the connect fails, attempt to

# start the remote server on the local host listening on port 2048. This

# is only done on platforms that support exec (i.e. not on the Mac). On

# platforms that do not support exec, the remote server must be started

# by the user before running the tests.

set remoteProcChan ""

set commandSocket ""

if {$doTestsWithRemoteServer} {

    catch {close $commandSocket}

    if {[catch {set commandSocket [socket $remoteServerIP \

						$remoteServerPort]}] != 0} {

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

	    set noRemoteTestReason "can't exec"

	    set doTestsWithRemoteServer 0

	} else {

	    set remoteServerIP 127.0.0.1

	    # Be *extra* careful in case this file is sourced from

	    # a directory other than the current one...

	    set remoteFile [file join [pwd] [file dirname [info script]] \

		    remote.tcl]

	    if {[catch {set remoteProcChan \

				[open "|[list [interpreter] $remoteFile \

					-serverIsSilent \

					-port $remoteServerPort \

					-address $remoteServerIP]" \

					w+]} \

		   msg] == 0} {

		after 1000

		if {[catch {set commandSocket [socket $remoteServerIP \

				$remoteServerPort]} msg] == 0} {

		    fconfigure $commandSocket -translation crlf -buffering line

		} else {

		    set noRemoteTestReason $msg

		    set doTestsWithRemoteServer 0

		}

	    } else {

		set noRemoteTestReason "$msg [interpreter]"

		set doTestsWithRemoteServer 0

	    }

	}

    } else {

	fconfigure $commandSocket -translation crlf -buffering line

    }

}

# Some tests are run only if we are doing testing against a remote server.

set ::tcltest::testConstraints(doTestsWithRemoteServer) $doTestsWithRemoteServer

if {$doTestsWithRemoteServer == 0} {

    if {[string first s $::tcltest::verbose] != -1} {

    	puts "Skipping tests with remote server. See tests/socket.test for"

	puts "information on how to run remote server."

	puts "Reason for not doing remote tests: $noRemoteTestReason"

    }

}

#

# If we do the tests, define a command to send a command to the

# remote server.

#

if {$doTestsWithRemoteServer == 1} {

    proc sendCommand {c} {

	global commandSocket

	if {[eof $commandSocket]} {

	    error "remote server disappeared"

	}

	if {[catch {puts $commandSocket $c} msg]} {

	    error "remote server disappaered: $msg"

	}

	if {[catch {puts $commandSocket "--Marker--Marker--Marker--"} msg]} {

	    error "remote server disappeared: $msg"

	}

	set resp ""

	while {1} {

	    set line [gets $commandSocket]

	    if {[eof $commandSocket]} {

		error "remote server disappaered"

	    }

	    if {[string compare $line "--Marker--Marker--Marker--"] == 0} {

		if {[string compare [lindex $resp 0] error] == 0} {

		    error [lindex $resp 1]

		} else {

		    return [lindex $resp 1]

		}

	    } else {

		append resp $line "\n"

	    }

	}

    }

}

test socket-1.1 {arg parsing for socket command} {socket} {

    list [catch {socket -server} msg] $msg

} {1 {no argument given for -server option}}

test socket-1.2 {arg parsing for socket command} {socket} {

    list [catch {socket -server foo} msg] $msg

} {1 {wrong # args: should be either:

socket ?-myaddr addr? ?-myport myport? ?-async? host port

socket -server command ?-myaddr addr? port}}

test socket-1.3 {arg parsing for socket command} {socket} {

    list [catch {socket -myaddr} msg] $msg

} {1 {no argument given for -myaddr option}}

test socket-1.4 {arg parsing for socket command} {socket} {

    list [catch {socket -myaddr 127.0.0.1} msg] $msg

} {1 {wrong # args: should be either:

socket ?-myaddr addr? ?-myport myport? ?-async? host port

socket -server command ?-myaddr addr? port}}

test socket-1.5 {arg parsing for socket command} {socket} {

    list [catch {socket -myport} msg] $msg

} {1 {no argument given for -myport option}}

test socket-1.6 {arg parsing for socket command} {socket} {

    list [catch {socket -myport xxxx} msg] $msg

} {1 {expected integer but got "xxxx"}}

test socket-1.7 {arg parsing for socket command} {socket} {

    list [catch {socket -myport 2522} msg] $msg

} {1 {wrong # args: should be either:

socket ?-myaddr addr? ?-myport myport? ?-async? host port

socket -server command ?-myaddr addr? port}}

test socket-1.8 {arg parsing for socket command} {socket} {

    list [catch {socket -froboz} msg] $msg

} {1 {bad option "-froboz": must be -async, -myaddr, -myport, or -server}}

test socket-1.9 {arg parsing for socket command} {socket} {

    list [catch {socket -server foo -myport 2521 3333} msg] $msg

} {1 {Option -myport is not valid for servers}}

test socket-1.10 {arg parsing for socket command} {socket} {

    list [catch {socket host 2528 -junk} msg] $msg

} {1 {wrong # args: should be either:

socket ?-myaddr addr? ?-myport myport? ?-async? host port

socket -server command ?-myaddr addr? port}}

test socket-1.11 {arg parsing for socket command} {socket} {

    list [catch {socket -server callback 2520 --} msg] $msg

} {1 {wrong # args: should be either:

socket ?-myaddr addr? ?-myport myport? ?-async? host port

socket -server command ?-myaddr addr? port}}

test socket-1.12 {arg parsing for socket command} {socket} {

    list [catch {socket foo badport} msg] $msg

} {1 {expected integer but got "badport"}}

test socket-1.13 {arg parsing for socket command} {socket} {

list [catch {socket -async -server} msg] $msg

} {1 {cannot set -async option for server sockets}}

test socket-1.14 {arg parsing for socket command} {socket} {

list [catch {socket -server foo -async} msg] $msg

} {1 {cannot set -async option for server sockets}}

set path(script) [makeFile {} script]

test socket-2.1 {tcp connection} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set timer [after 10000 "set x timed_out"]

	set f [socket -server accept 0]

	proc accept {file addr port} {

	    global x

	    set x done

            close $file

	}

	puts ready

	puts [lindex [fconfigure $f -sockname] 2]

	vwait x

	after cancel $timer

	close $f

	puts $x

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f x

    gets $f listen

    if {[catch {socket 127.0.0.1 $listen} msg]} {

        set x $msg

    } else {

        lappend x [gets $f]

        close $msg

    }

    lappend x [gets $f]

    close $f

    set x

} {ready done {}}

if [info exists port] {

    incr port

} else { 

    set port [expr 2048 + [pid]%1024]

}

test socket-2.2 {tcp connection with client port specified} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set timer [after 10000 "set x timeout"]

        set f [socket -server accept 0]

	proc accept {file addr port} {

            global x

            puts "[gets $file] $port"

            close $file

            set x done

	}

	puts ready

	puts [lindex [fconfigure $f -sockname] 2]

	vwait x

	after cancel $timer

	close $f

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f x

    gets $f listen

    global port

    if {[catch {socket -myport $port 127.0.0.1 $listen} sock]} {

        set x $sock

	close [socket 127.0.0.1 $listen]

	puts stderr $sock

    } else {

        puts $sock hello

	flush $sock

        lappend x [gets $f]

        close $sock

    }

    close $f

    set x

} [list ready "hello $port"]

test socket-2.3 {tcp connection with client interface specified} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set timer [after 2000 "set x done"]

        set f [socket  -server accept 2830]

	proc accept {file addr port} {

            global x

            puts "[gets $file] $addr"

            close $file

            set x done

	}

	puts ready

	vwait x

	after cancel $timer

	close $f

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f x

    if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {

        set x $sock

    } else {

        puts $sock hello

	flush $sock

        lappend x [gets $f]

        close $sock

    }

    close $f

    set x

} {ready {hello 127.0.0.1}}

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

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set timer [after 2000 "set x done"]

        set f [socket -server accept -myaddr 127.0.0.1 0]

	proc accept {file addr port} {

            global x

            puts "[gets $file]"

            close $file

            set x done

	}

	puts ready

	puts [lindex [fconfigure $f -sockname] 2]

	vwait x

	after cancel $timer

	close $f

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f x

    gets $f listen

    if {[catch {socket 127.0.0.1 $listen} sock]} {

        set x $sock

    } else {

        puts $sock hello

	flush $sock

        lappend x [gets $f]

        close $sock

    }

    close $f

    set x

} {ready hello}

test socket-2.5 {tcp connection with redundant server port} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set timer [after 10000 "set x timeout"]

        set f [socket -server accept 0]

	proc accept {file addr port} {

            global x

            puts "[gets $file]"

            close $file

            set x done

	}

	puts ready

	puts [lindex [fconfigure $f -sockname] 2]

	vwait x

	after cancel $timer

	close $f

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f x

    gets $f listen

    if {[catch {socket 127.0.0.1 $listen} sock]} {

        set x $sock

    } else {

        puts $sock hello

	flush $sock

        lappend x [gets $f]

        close $sock

    }

    close $f

    set x

} {ready hello}

test socket-2.6 {tcp connection} {socket} {

    set status ok

    if {![catch {set sock [socket 127.0.0.1 2833]}]} {

	if {![catch {gets $sock}]} {

	    set status broken

	}

	close $sock

    }

    set status

} ok

test socket-2.7 {echo server, one line} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set timer [after 10000 "set x timeout"]

	set f [socket -server accept 0]

	proc accept {s a p} {

            fileevent $s readable [list echo $s]

	    fconfigure $s -translation lf -buffering line

        }

	proc echo {s} {

	     set l [gets $s]

             if {[eof $s]} {

                 global x

                 close $s

                 set x done

             } else {

                 puts $s $l

             }

	}

	puts ready

	puts [lindex [fconfigure $f -sockname] 2]

	vwait x

	after cancel $timer

	close $f

	puts $x

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f

    gets $f listen

    set s [socket 127.0.0.1 $listen]

    fconfigure $s -buffering line -translation lf

    puts $s "hello abcdefghijklmnop"

    after 1000

    set x [gets $s]

    close $s

    set y [gets $f]

    close $f

    list $x $y

} {{hello abcdefghijklmnop} done}

removeFile script

test socket-2.8 {echo server, loop 50 times, single connection} -constraints {socket stdio} -setup {

    set path(script) [makeFile {

	set f [socket -server accept 0]

	proc accept {s a p} {

            fileevent $s readable [list echo $s]

            fconfigure $s -buffering line

        }

	proc echo {s} {

	     global i

             set l [gets $s]

             if {[eof $s]} {

                 global x

                 close $s

                 set x done

             } else { 

	         incr i

                 puts $s $l

             }

	}

	set i 0

	puts ready

	puts [lindex [fconfigure $f -sockname] 2]

	set timer [after 20000 "set x done"]

	vwait x

	after cancel $timer

	close $f

	puts "done $i"

    } script]

} -body {

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f

    gets $f listen

    set s [socket 127.0.0.1 $listen]

    fconfigure $s -buffering line

    catch {

	for {set x 0} {$x < 50} {incr x} {

	    puts $s "hello abcdefghijklmnop"

	    gets $s

	}

    }

    close $s

    catch {set x [gets $f]}

    close $f

    set x

} -cleanup {

    removeFile script

} -result {done 50}

set path(script) [makeFile {} script]

test socket-2.9 {socket conflict} {socket stdio} {

    set s [socket -server accept 0]

    file delete $path(script)

    set f [open $path(script) w]

    puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f

    after 100

    set x [list [catch {close $f} msg]]

    regsub "\n.*$" $msg {} msg ; # cut part of the error message containing the port number

    lappend x $msg

    close $s

    set x

} {1 {couldn't open socket: address already in use}}

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 0]

    proc accept {s a p} {

	global ss

	close $ss

	fileevent $s readable "readit $s"

	fconfigure $s -trans lf

    }

    proc readit {s} {

	global done

	gets $s

	close $s

	set done 1

    }

    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]

    puts $cs hello

    close $cs

    vwait done

    after cancel $timer

    set done

} 1

test socket-2.11 {detecting new data} {socket} {

    proc accept {s a p} {

	global sock

	set sock $s

    }

    set s [socket -server accept 0]

    set sock ""

    set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]

    vwait sock

    puts $s2 one

    flush $s2

    after 500

    fconfigure $sock -blocking 0

    set result a:[gets $sock]

    lappend result b:[gets $sock]

    fconfigure $sock -blocking 1

    puts $s2 two

    flush $s2

    fconfigure $sock -blocking 0

    lappend result c:[gets $sock]

    fconfigure $sock -blocking 1

    close $s2

    close $s

    close $sock

    set result

} {a:one b: c:two}

test socket-3.1 {socket conflict} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set f [socket -server accept 0]

	puts ready

	puts [lindex [fconfigure $f -sockname] 2]

	gets stdin

	close $f

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r+]

    gets $f

    gets $f listen

    set x [list [catch {socket -server accept $listen} msg] \

		$msg]

    puts $f bye

    close $f

    set x

} {1 {couldn't open socket: address already in use}}

test socket-3.2 {server with several clients} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set t1 [after 30000 "set x timed_out"]

	set t2 [after 31000 "set x timed_out"]

	set t3 [after 32000 "set x timed_out"]

	set counter 0

	set s [socket -server accept 0]

	proc accept {s a p} {

	    fileevent $s readable [list echo $s]

	    fconfigure $s -buffering line

	}

	proc echo {s} {

	     global x

             set l [gets $s]

             if {[eof $s]} {

                 close $s

                 set x done

             } else {

                 puts $s $l

             }

	}

	puts ready

	puts [lindex [fconfigure $s -sockname] 2]

	vwait x

	after cancel $t1

	vwait x

	after cancel $t2

	vwait x

	after cancel $t3

	close $s

	puts $x

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r+]

    set x [gets $f]

    gets $f listen

    set s1 [socket 127.0.0.1 $listen]

    fconfigure $s1 -buffering line

    set s2 [socket 127.0.0.1 $listen]

    fconfigure $s2 -buffering line

    set s3 [socket 127.0.0.1 $listen]

    fconfigure $s3 -buffering line

    for {set i 0} {$i < 100} {incr i} {

	puts $s1 hello,s1

	gets $s1

	puts $s2 hello,s2

	gets $s2

	puts $s3 hello,s3

	gets $s3

    }

    close $s1

    close $s2

    close $s3

    lappend x [gets $f]

    close $f

    set x

} {ready done}

test socket-4.1 {server with several clients} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set port [gets stdin]

	set s [socket 127.0.0.1 $port]

	fconfigure $s -buffering line

	for {set i 0} {$i < 100} {incr i} {

	    puts $s hello

	    gets $s

	}

	close $s

	puts bye

	gets stdin

    }

    close $f

    set p1 [open "|[list [interpreter] $path(script)]" r+]

    fconfigure $p1 -buffering line

    set p2 [open "|[list [interpreter] $path(script)]" r+]

    fconfigure $p2 -buffering line

    set p3 [open "|[list [interpreter] $path(script)]" r+]

    fconfigure $p3 -buffering line

    proc accept {s a p} {

	fconfigure $s -buffering line

	fileevent $s readable [list echo $s]

    }

    proc echo {s} {

	global x

        set l [gets $s]

        if {[eof $s]} {

            close $s

            set x done

        } else {

            puts $s $l

        }

    }

    set t1 [after 30000 "set x timed_out"]

    set t2 [after 31000 "set x timed_out"]

    set t3 [after 32000 "set x timed_out"]

    set s [socket -server accept 0]

    set listen [lindex [fconfigure $s -sockname] 2]

    puts $p1 $listen

    puts $p2 $listen

    puts $p3 $listen

    vwait x

    vwait x

    vwait x

    after cancel $t1

    after cancel $t2

    after cancel $t3

    close $s

    set l ""

    lappend l [list p1 [gets $p1] $x]

    lappend l [list p2 [gets $p2] $x]

    lappend l [list p3 [gets $p3] $x]

    puts $p1 bye

    puts $p2 bye

    puts $p3 bye

    close $p1

    close $p2

    close $p3

    set l

} {{p1 bye done} {p2 bye done} {p3 bye done}}

test socket-4.2 {byte order problems, socket numbers, htons} {socket} {

    set x ok

    if {[catch {socket -server dodo 0x3000} msg]} {

	set x $msg

    } else {

	close $msg

    }

    set x

} ok

test socket-5.1 {byte order problems, socket numbers, htons} \

	{socket unixOnly notRoot} {

    set x {couldn't open socket: not owner}

    if {![catch {socket -server dodo 0x1} msg]} {

        set x {htons problem, should be disallowed, are you running as SU?}

	close $msg

    }

    set x

} {couldn't open socket: not owner}

test socket-5.2 {byte order problems, socket numbers, htons} {socket} {

    set x {couldn't open socket: port number too high}

    if {![catch {socket -server dodo 0x10000} msg]} {

	set x {port resolution problem, should be disallowed}

	close $msg

    }

    set x

} {couldn't open socket: port number too high}

test socket-5.3 {byte order problems, socket numbers, htons} \

	{socket unixOnly notRoot} {

    set x {couldn't open socket: not owner}

    if {![catch {socket -server dodo 21} msg]} {

	set x {htons problem, should be disallowed, are you running as SU?}

	close $msg

    }

    set x

} {couldn't open socket: not owner}

test socket-6.1 {accept callback error} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	gets stdin port

	socket 127.0.0.1 $port

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r+]

    proc bgerror args {

	global x

	set x $args

    }

    proc accept {s a p} {expr 10 / 0}

    set s [socket -server accept 0]

    puts $f [lindex [fconfigure $s -sockname] 2]

    close $f

    set timer [after 10000 "set x timed_out"]

    vwait x

    after cancel $timer

    close $s

    rename bgerror {}

    set x

} {{divide by zero}}

test socket-7.1 {testing socket specific options} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set ss [socket -server accept 0]

	proc accept args {

	    global x

	    set x done

	}

	puts ready

	puts [lindex [fconfigure $ss -sockname] 2]

	set timer [after 10000 "set x timed_out"]

	vwait x

	after cancel $timer

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f

    gets $f listen

    set s [socket 127.0.0.1 $listen]

    set p [fconfigure $s -peername]

    close $s

    close $f

    set l ""

    lappend l [string compare [lindex $p 0] 127.0.0.1]

    lappend l [string compare [lindex $p 2] $listen]

    lappend l [llength $p]

} {0 0 3}

test socket-7.2 {testing socket specific options} {socket stdio} {

    file delete $path(script)

    set f [open $path(script) w]

    puts $f {

	set ss [socket -server accept 2821]

	proc accept args {

	    global x

	    set x done

	}

	puts ready

	puts [lindex [fconfigure $ss -sockname] 2]

	set timer [after 10000 "set x timed_out"]

	vwait x

	after cancel $timer

    }

    close $f

    set f [open "|[list [interpreter] $path(script)]" r]

    gets $f

    gets $f listen

    set s [socket 127.0.0.1 $listen]

    set p [fconfigure $s -sockname]

    close $s

    close $f

    list [llength $p] \

	    [regexp {^(127\.0\.0\.1|0\.0\.0\.0)$} [lindex $p 0]] \

	    [expr {[lindex $p 2] == $listen}]

} {3 1 0}

test socket-7.3 {testing socket specific options} {socket} {

    set s [socket -server accept 0]

    set l [fconfigure $s]

    close $s

    update

    llength $l

} 14

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

    set s [socket -server accept 0]

    proc accept {s a p} {

	global x

	set x [fconfigure $s -sockname]

	close $s

    }

    set listen [lindex [fconfigure $s -sockname] 2]

    set s1 [socket [info hostname] $listen]

    set timer [after 10000 "set x timed_out"]

    vwait x

    after cancel $timer

    close $s

    close $s1

    set l ""

    lappend l [expr {[lindex $x 2] == $listen}] [llength $x]

} {1 3}

test socket-7.5 {testing socket specific options} {socket unixOrPc} {

    set s [socket -server accept 0]

    proc accept {s a p} {

	global x

	set x [fconfigure $s -sockname]

	close $s

    }

    set listen [lindex [fconfigure $s -sockname] 2]

    set s1 [socket 127.0.0.1 $listen]

    set timer [after 10000 "set x timed_out"]

    vwait x

    after cancel $timer

    close $s

    close $s1

    set l ""

    lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]

} {127.0.0.1 1 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):

    #

    # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,

    # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,

    # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,

    # 102066-04, 102070-01, 102105-01, 102153-03, 102216-01, 102232-01,

    # 101878-03, 101879-01, 101880-03, 101933-01, 101950-01, 102030-01,

    # 102057-08, 102140-01, 101920-02, 101921-09, 101922-07, 101923-03

    #

    # If after installing these patches you are still experiencing a

    # problem, please email jyl@eng.sun.com. We have not observed this

    # failure on Solaris 2.5, so another option (instead of installing

    # these patches) is to upgrade to Solaris 2.5.

    set s [socket -server accept 0]

    proc accept {s a p} {

	global x

	puts $s bye

	close $s

	set x done

    }

    set s1 [socket -async [info hostname] [lindex [fconfigure $s -sockname] 2]]

    vwait x

    set z [gets $s1]

    close $s

    close $s1

    set z

} bye

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

    set len 0

    set spurious 0

    set done 0

    proc readlittle {s} {

	global spurious done len

	set l [read $s 1]

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

	    if {![eof $s]} {

		incr spurious

	    } else {

		close $s

		set done 1

	    }

	} else {

	    incr len [string length $l]

	}

    }

    proc accept {s a p} {

	fconfigure $s -buffering none -blocking off

	fileevent $s readable [list readlittle $s]

    }

    set s [socket -server accept 0]

    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]

    puts -nonewline $c 01234567890123456789012345678901234567890123456789

    close $c

    set timer [after 10000 "set done timed_out"]

    vwait done

    after cancel $timer

    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 ""

    for {set i 0} {$i < 16} {incr i} {

	set secondblock "b$secondblock$secondblock"

    }

    set l [socket -server accept 0]

    proc accept {s a p} {

	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \

		-buffering line

	fileevent $s readable "readable $s"

    }

    proc readable {s} {

	set l [gets $s]

	fileevent $s readable {}

	after 1000 respond $s

    }

    proc respond {s} {

	global firstblock

	puts -nonewline $s $firstblock

	after 1000 writedata $s

    }

    proc writedata {s} {

	global secondblock

	puts -nonewline $s $secondblock

	close $s

    }

    set s [socket [info hostname] [lindex [fconfigure $l -sockname] 2]]

    fconfigure $s -blocking 0 -trans lf -buffering line

    set count 0

    puts $s hello

    proc readit {s} {

	global count done

	set l [read $s]

	incr count [string length $l]

	if {[eof $s]} {

	    close $s

	    set done 1