# 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.40.2.16 2008/04/07 22:17:37 andreas_kupries Exp $

if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
namespace eval ::tcl::test::io {

    close $pipe
    rename ::done {}
    after 1000 ;# Give Windows time to kill the process
    removeFile out
    removeFile err
    catch {unset ::forever}
} -result OK
test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
    set err [makeFile {} err]
    set pipe [open "|[info nameofexecutable] 2> $err" r+]
    fconfigure $pipe -translation binary -buffering line
    puts $pipe {
	fconfigure stderr -buffering line
	# Kill server when pipe closed by invoker.
	proc bye args {
	    if {![eof stdin]} { gets stdin ; return }
	    puts stderr BYE
	    exit
	}
	# Server code. Bi-directional copy between 2 sockets.
	proc geof {sok} {
	    puts stderr DONE/$sok
	    close $sok
	}
	proc new {sok args} {
	    puts stderr NEW/$sok
	    global l srv
	    fconfigure $sok -translation binary -buffering none
	    lappend l $sok
	    if {[llength $l]==2} {
		close $srv
		foreach {a b} $l break
		fcopy $a $b -command [list geof $a]
		fcopy $b $a -command [list geof $b]
		puts stderr 2COPY
	    }
	    puts stderr ...
	}
	puts stderr SRV
	set l {}
	set srv [socket -server new 9999]
	puts stderr WAITING
	fileevent stdin readable bye
	puts OK
	vwait forever
    }
    # wait for OK from server.
    gets $pipe
    # Now the two clients.
    proc ::done {sock} {
	if {[eof $sock]} { close $sock ; return }
	lappend ::forever [gets $sock]
	return
    }
    set a [socket 127.0.0.1 9999]
    set b [socket 127.0.0.1 9999]
    fconfigure $a -translation binary -buffering none
    fconfigure $b -translation binary -buffering none
    fileevent  $a readable [list ::done $a]
    fileevent  $b readable [list ::done $b]
} -constraints {stdio openpipe fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}
    puts $a AB
    vwait ::forever
    puts $b BA
    vwait ::forever
    set ::forever
} -cleanup {
    catch {close $a}
    catch {close $b}
    close $pipe
    rename ::done {}
    after 1000 ;# Give Windows time to kill the process
    removeFile err
    catch {unset ::forever}
} -result {AB BA}

test io-54.1 {Recursive channel events} {socket fileevent} {
    # This test checks to see if file events are delivered during recursive
    # event loops when there is buffered data on the channel.

    proc accept {s a p} {
	variable as