# 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.81 2008/04/03 18:06:01 andreas_kupries Exp $
# RCS: @(#) $Id: io.test,v 1.82 2008/04/04 20:14:17 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 {
    namespace import ::tcltest::*

    # Run the copy. Should not invoke -command now.
    fcopy $f $g -size 2 -command ::cmd
    # Check that -command was not called synchronously
    set sbs [file size bar]
    lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs
    # Now let the async part happen. Should capture the error in cmd
    # via bgerror. If not break the event loop via timer.
    after 1000 {
    set token [after 1000 {
	lappend ::RES {bgerror/FAIL timeout}
	set ::forever has-been-reached
    }
    }]
    vwait ::forever
    catch {after cancel $token}
    # Report
    set ::RES
} -cleanup {
    close $f
    close $g
    catch {unset ::RES}
    catch {unset ::forever}
    rename ::cmd {}
    rename ::bgerror {}
    removeFile foo
    removeFile bar
} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
    set out [makeFile {} out]
    set err [makeFile {} err]
    set pipe [open "|[info nameofexecutable] 2> $err" r+]
    fconfigure $pipe -translation binary -buffering line
    puts $pipe {
	fconfigure stdout -translation binary -buffering line
	puts stderr Waiting...
	after 1000
	foreach x {a b c} {
	    puts stderr Looping...
	    puts $x
	    after 500
	}
	proc bye args {
	    if {[gets stdin line]<0} {
		puts stderr "CHILD: EOF detected, exiting"
		exit
	    } else {
		puts stderr "CHILD: ignoring line: $line"
	    }
	}
	puts stderr Now-sleeping-forever
	fileevent stdin readable bye
	vwait forever
    }
    proc ::done args {
	set ::forever OK
	return
    }
    set ::forever {}
    set out [open $out w]
} -constraints {stdio openpipe fcopy} -body {
    fcopy $pipe $out -size 6 -command ::done
    set token [after 5000 {
	set ::forever {fcopy hangs}
    }]
    vwait ::forever
    catch {after cancel $token}
    set ::forever
} -cleanup {
    close $pipe
    rename ::done {}
    removeFile out
    removeFile err
    catch {unset ::forever}
} -result OK

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