# This file contains a collection of tests for the procedures in the file
# tclEvent.c, which includes the "update", and "vwait" Tcl
# commands.  Sourcing this file into Tcl runs the tests and generates
# output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-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: event.test,v 1.18 2002/07/02 19:10:57 dgp Exp $
# RCS: @(#) $Id: event.test,v 1.19 2002/07/05 10:38:42 dkf Exp $

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

::tcltest::testConstraint testfilehandler \

    rename bgerror {}
    set x
} {{a simple error}}

test event-6.1 {BgErrorDeleteProc procedure} {
    catch {interp delete foo}
    interp create foo
    set erroutfile [makeFile Unmodified err.out]
    foo eval [list set erroutfile $erroutfile]
    foo eval {
	proc bgerror args {
	    global errorInfo
	    set f [open err.out r+]
	    global errorInfo erroutfile
	    set f [open $erroutfile r+]
	    seek $f 0 end
	    puts $f "$args $errorInfo"
	    close $f
	}
	after 100 {error "first error"}
	after 100 {error "second error"}
    }
    makeFile Unmodified err.out
    after 100 {interp delete foo}
    after 200
    update
    set f [open err.out r]
    set f [open $erroutfile r]
    set result [read $f]
    close $f
    removeFile err.out
    removeFile $erroutfile
    set result
} {Unmodified
}

test event-7.1 {bgerror / regular} {
    set errRes {}
    proc bgerror {err} {

} {{} x-done y-done before q-done}

foreach i [after info] {
    after cancel $i
}

test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
    set test1file [makeFile "" test1]
    set f1 [open test1 w]
    set f1 [open $test1file w]
    proc accept {s args} {
	puts $s foobar
	close $s
    }
    catch {set s1 [socket -server accept 0]}
    after 1000
    catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
    close $s1
    set x 0
    set y 0
    set z 0
    fileevent $s2 readable { incr z }
    fileevent $s2 readable {incr z}
    vwait z
    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
    fileevent $s2 readable { incr y; if { $x == 3 } { set z done } }
    fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
    fileevent $s2 readable {incr y; if {$x == 3} {set z done}}
    vwait z
    close $f1
    close $s2
    file delete test1 test2
    removeFile $test1file
    list $x $y $z
} {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
    file delete test1 test2
    set f1 [open test1 w]
    set f2 [open test2 w]
    set test1file [makeFile "" test1]
    set test2file [makeFile "" test2]
    set f1 [open $test1file w]
    set f2 [open $test2file w]
    set x 0
    set y 0
    set z 0
    update
    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
    fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }
    fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
    fileevent $f2 writable {incr y; if {$x == 3} {set z done}}
    vwait z
    close $f1
    close $f2
    file delete test1 test2
    removeFile $test1file
    removeFile $test2file
    list $x $y $z
} {3 3 done}


test event-12.1 {Tcl_UpdateCmd procedure} {
    list [catch {update a b} msg] $msg
} {1 {wrong # args: should be "update ?idletasks?"}}

# cleanup
foreach i [after info] {
    after cancel $i
}
::tcltest::cleanupTests
return