# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.21 2001/09/11 17:30:44 andreas_kupries Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

tcltest::testConstraint testchannel [string equal testchannel [info commands testchannel]]

	if {[eof $s]} {
	    close $s
	    set x done
	} elseif {([string length $l] > 0) || ![fblocked $s]} {
	    incr c
	}
    }
    set ss [socket -server accept 0]
    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
    vwait x
    fconfigure $cs -blocking off
    writelots $cs $l
    close $cs
    close $ss
    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().
     
    catch {interp delete x}
    catch {interp delete y}
    interp create x
    interp create y
    set s [socket -server accept 0]
    proc accept {s a p} {
	puts $s hello
	close $s
    }
    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
    interp share {} $c x
    interp share {} $c y
    close $c
    x eval {
	proc readit {s} {
	    gets $s
	    if {[eof $s]} {

    proc accept {s a p} {
	global x wait
	fconfigure $s -blocking off
	puts $s "sock[incr x]"
	close $s
	set wait done
    }
    set ss [socket -server accept 0]
    set wait ""
    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
    vwait wait
    lappend result [gets $cs]
    close $cs

    set wait ""
    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
    vwait wait
    lappend result [gets $cs]
    close $cs

    set wait ""
    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
    vwait wait
    lappend result [gets $cs]
    close $cs

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






    vwait wait
    lappend result [gets $cs]
    close $cs
    close $ss
    set result
} {sock1 sock2 sock3 sock4}

	set fcopyTestDone 1
    } else {
	set fcopyTestDone 0
    }
}

test io-53.5 {CopyData: error during fcopy} {socket} {
    set listen [socket -server FcopyTestAccept 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    close $listen	;# This means the socket open never really succeeds
    fcopy $in $out -command FcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait fcopyTestDone		;# The error occurs here in the b.g.
    }
    close $in

	lappend result $next
	if {$next == 1} {
	    fileevent $s readable [list readit $s 2]
	    vwait x
	}
	incr x
    }
    set ss [socket -server accept 0]

    # We need to delay on some systems until the creation of the
    # server socket completes.

    set done 0
    for {set i 0} {$i < 10} {incr i} {
	if {![catch {set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]}]} {
	    set done 1
	    break
	}
	after 100
    }
    if {$done == 0} {
	close $ss

    close $ss
    close $cs
    list $result $x
} {{{line 1} 1 2} 2}
test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
    set accept {}
    set after {}
    set s [socket -server accept 0]
    proc accept {s a p} {
	global counter accept

	set accept $s
	set counter 0
	fconfigure $s -blocking off -buffering line -translation lf
	fileevent $s readable "doit $s"

	incr counter
	set l [gets $s]
	close $s
	set accept {}
    }
    proc producer {} {
	global writer s

	set writer [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
	fconfigure $writer -buffering line
	puts -nonewline $writer hello
	flush $writer
    }
    proc newline {} {
	global writer done

    lappend result $y
} {2 done}

test io-57.1 {buffered data and file events, gets} {
    proc accept {sock args} {
	set ::s2 $sock
    }
    set server [socket -server accept 0]
    set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
    vwait s2
    update
    fileevent $s2 readable {lappend result readable}
    puts $s "12\n34567890"
    flush $s
    set result [gets $s2]
    after 1000 {lappend result timer}
    vwait result
    lappend result [gets $s2]
    vwait result
    close $s
    close $s2
    close $server
    set result
} {12 readable 34567890 timer}
test io-57.2 {buffered data and file events, read} {
    proc accept {sock args} {
	set ::s2 $sock
    }
    set server [socket -server accept 0]
    set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
    vwait s2
    update
    fileevent $s2 readable {lappend result readable}
    puts -nonewline $s "1234567890"
    flush $s
    set result [read $s2 1]
    after 1000 {lappend result timer}