# 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.64 2004/11/11 01:16:06 das Exp $
# RCS: @(#) $Id: io.test,v 1.65 2004/11/18 19:22:12 dgp Exp $

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

	set x [gets $f2]; fileevent $f2 readable {}
    }]
    puts $f2 text; flush $f2
    variable x initial
    vwait [namespace which -variable x]
    set x
} {text}
test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs fileevent} {
    proc ::bgerror args "set [namespace which -variable x] \$args"
test io-44.2 {FileEventProc procedure: error in read event} -constraints {
    stdio unixExecs fileevent
} -setup {
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
} -body {
    fileevent $f2 readable {error bogus}
    puts $f2 text; flush $f2
    variable x initial
    vwait [namespace which -variable x]
    rename ::bgerror {}
    list $x [fileevent $f2 readable]
} -cleanup {
    interp bgerror {} $handler
} {bogus {}}
} -result {bogus {}}
test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs fileevent} {
    fileevent $f2 writable [namespace code {
	lappend x "triggered"
	incr count -1
	if {$count <= 0} {
	    fileevent $f2 writable {}
	}
    }]
    variable x initial
    set count 3
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    set x
} {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs fileevent} {
    proc ::bgerror args "set [namespace which -variable x] \$args"
test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
    stdio unixExecs fileevent
} -setup {
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
} -body {
    fileevent $f2 writable {error bad-write}
    variable x initial
    vwait [namespace which -variable x]
    rename ::bgerror {}
    list $x [fileevent $f2 writable]
} -cleanup {
    interp bgerror {} $handler
} {bad-write {}}
} -result {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
    set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
    fileevent $f4 readable [namespace code {
	if {[gets $f4 line] < 0} {
	    lappend x eof
	    fileevent $f4 readable {}
	} else {

    after cancel $after
    if {$accept != {}} {close $accept}
    set counter
} 1

set path(fooBar) [makeFile {} fooBar]

test io-55.1 {ChannelEventScriptInvoker: deletion} {fileevent} {
test io-55.1 {ChannelEventScriptInvoker: deletion} -constraints {
    fileevent
} -setup {
    variable x
    proc eventScript {fd} {
	variable x
	close $fd
	error "planned error"
	set x whoops
    }
    proc myHandler args {
	variable x got_error
    }
    set handler [interp bgerror {}]
    proc ::bgerror {args} "set [namespace which -variable x] got_error"
    interp bgerror {} [namespace which myHandler]
} -body {
    set f [open $path(fooBar) w]
    fileevent $f writable [namespace code [list eventScript $f]]
    variable x not_done
    vwait [namespace which -variable x]
    set x
} -cleanup {
    interp bgerror {} $handler
} {got_error}
} -result {got_error}

test io-56.1 {ChannelTimerProc} {testchannelevent} {
    set f [open $path(fooBar) w]
    puts $f "this is a test"
    close $f
    set f [open $path(fooBar) r]
    testchannelevent $f add readable [namespace code {