event.test

来自「tcl是工具命令语言」· TEST 代码 · 共 595 行 · 第 1/2 页

catch {rename bgerror {}}


test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; exit"
    flush $child
    set result [read $child]
    close $child
    set result
} {even 6
even 4
odd 41
}

test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 41"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    set result
} {even 16
even 6
even 4
}
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 4"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    set result
    } {even 16
even 6
odd 41
}
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 6"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    set result
} {even 16
even 4
odd 41
}
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "testexithandler create 41; testexithandler delete 41"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    set result
} {even 16
}

test event-10.1 {Tcl_Exit procedure} {stdio} {
    set child [open |[list [interpreter]] r+]
    puts $child "exit 3"
    list [catch {close $child} msg] $msg [lindex $errorCode 0] \
        [lindex $errorCode 2]
} {1 {child process exited abnormally} CHILDSTATUS 3}

test event-11.1 {Tcl_VwaitCmd procedure} {
    list [catch {vwait} msg] $msg
} {1 {wrong # args: should be "vwait name"}}
test event-11.2 {Tcl_VwaitCmd procedure} {
    list [catch {vwait a b} msg] $msg
} {1 {wrong # args: should be "vwait name"}}
test event-11.3 {Tcl_VwaitCmd procedure} {
    catch {unset x}
    set x 1
    list [catch {vwait x(1)} msg] $msg
} {1 {can't trace "x(1)": variable isn't array}}
test event-11.4 {Tcl_VwaitCmd procedure} {} {
    foreach i [after info] {
	after cancel $i
    }
    after 10; update; # On Mac make sure update won't take long
    after 100 {set x x-done}
    after 200 {set y y-done}
    after 300 {set z z-done}
    after idle {set q q-done}
    set x before
    set y before
    set z before
    set q before
    list [vwait y] $x $y $z $q
} {{} 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 $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}
    vwait z
    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
    removeFile $test1file
    list $x $y $z
} {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
    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}}
    vwait z
    close $f1
    close $f2
    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?"}}
test event-12.2 {Tcl_UpdateCmd procedure} {
    list [catch {update bogus} msg] $msg
} {1 {bad option "bogus": must be idletasks}}
test event-12.3 {Tcl_UpdateCmd procedure} {
    foreach i [after info] {
	after cancel $i
    }
    after 500 {set x after}
    after idle {set y after}
    after idle {set z "after, y = $y"}
    set x before
    set y before
    set z before
    update idletasks
    list $x $y $z
} {before after {after, y = after}}
test event-12.4 {Tcl_UpdateCmd procedure} {
    foreach i [after info] {
	after cancel $i
    }
    after 10; update; # On Mac make sure update won't take long
    after 200 {set x x-done}
    after 600 {set y y-done}
    after idle {set z z-done}
    set x before
    set y before
    set z before
    after 300
    update
    list $x $y $z
} {x-done before z-done}

test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
    foreach i [after info] {
	after cancel $i
    }
    after 100 set x timeout
    testfilehandler close
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 readable 0]
    update
    testfilehandler close
    list $result $x
} {{} {no timeout}}
test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
    after 100 set x timeout
    testfilehandler close
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 readable 100]
    update
    testfilehandler close
    list $result $x
} {{} timeout}
test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
    after 100 set x timeout
    testfilehandler close
    testfilehandler create 1 off off
    testfilehandler fillpartial 1
    set x "no timeout"
    set result [testfilehandler wait 1 readable 100]
    update
    testfilehandler close
    list $result $x
} {readable {no timeout}}
test event-13.4 {Tcl_WaitForFile procedure, writable} \
	{testfilehandler nonPortable} {
    foreach i [after info] {
	after cancel $i
    }
    after 100 set x timeout
    testfilehandler close
    testfilehandler create 1 off off
    testfilehandler fill 1
    set x "no timeout"
    set result [testfilehandler wait 1 writable 0]
    update
    testfilehandler close
    list $result $x
} {{} {no timeout}}
test event-13.5 {Tcl_WaitForFile procedure, writable} \
	{testfilehandler nonPortable} {
    foreach i [after info] {
	after cancel $i
    }
    after 100 set x timeout
    testfilehandler close
    testfilehandler create 1 off off
    testfilehandler fill 1
    set x "no timeout"
    set result [testfilehandler wait 1 writable 100]
    update
    testfilehandler close
    list $result $x
} {{} timeout}
test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
    after 100 set x timeout
    testfilehandler close
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 writable 100]
    update
    testfilehandler close
    list $result $x
} {writable {no timeout}}
test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
    after 100 lappend x timeout
    after idle lappend x idle
    testfilehandler close
    testfilehandler create 1 off off
    set x ""
    set result [list [testfilehandler wait 1 readable 200] $x]
    update
    testfilehandler close
    lappend result $x
} {{} {} {timeout idle}}

test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
    set f [open "|sleep 2" r]
    set result ""
    lappend result [testfilewait $f readable 100]
    lappend result [testfilewait $f readable -1]
    close $f
    set result
} {{} readable}

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