Ultra Pack/UltraComputing Partner Applications.iso/SunLabs/tclTK/src/tk4.0/tests/fevent.test

Text File | 1995-06-28 | 9.9 KB | 352 lines

# This file is a Tcl script to test the "fileevent" command.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) fevent.test 1.11 95/06/25 14:52:38

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
. configure -width 200 -height 200
wm geometry . {}
raise .
update
. configure -width 0 -height 0

set f [open foo w+]
set f2 [open {|cat -u} r+]
set f3 [open {|cat -u} r+]
test fevent-1.1 {Tk_FileeventCmd: errors} {
    list [catch {fileevent foo} msg] $msg
} {1 {wrong # args: must be "fileevent fileId event ?script?}}
test fevent-1.2 {Tk_FileeventCmd: errors} {
    list [catch {fileevent foo bar baz q} msg] $msg
} {1 {wrong # args: must be "fileevent fileId event ?script?}}
test fevent-1.3 {Tk_FileeventCmd: errors} {
    list [catch {fileevent gorp readable} msg] $msg
} {1 {bad file identifier "gorp"}}
test fevent-1.4 {Tk_FileeventCmd: errors} {
    list [catch {fileevent gorp writable} msg] $msg
} {1 {bad file identifier "gorp"}}
test fevent-1.5 {Tk_FileeventCmd: errors} {
    list [catch {fileevent gorp who-knows} msg] $msg
} {1 {bad event name "who-knows": must be readable or writable}}

test fevent-2.1 {Tk_FileeventCmd: creating, deleting, querying} {
    list [fileevent $f readable] [fileevent $f writable]
} {{} {}}
test fevent-2.2 {Tk_FileeventCmd: creating, deleting, querying} {
    set result {}
    fileevent $f readable "script 1"
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f writable "write script"
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f readable {}
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f writable {}
    lappend result [fileevent $f readable] [fileevent $f writable]
} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
test fevent-2.3 {Tk_FileeventCmd: deleting when many present} {
    set result {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r "read f"
    fileevent $f2 r "read f2"
    fileevent $f3 r "read f3"
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f2 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f3 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}

test fevent-3.1 {Tk_FileeventCmd: replacing} {
    set result {}
    fileevent $f r "first script"
    lappend result [fileevent $f readable]
    fileevent $f r "new script"
    lappend result [fileevent $f readable]
    fileevent $f r "yet another"
    lappend result [fileevent $f readable]
    fileevent $f r ""
    lappend result [fileevent $f readable]
} {{first script} {new script} {yet another} {}}

test fevent-4.1 {FileEventProc procedure: normal read event} {
    fileevent $f2 readable {set x [gets $f2]; fileevent $f2 readable {}}
    puts $f2 text; flush $f2
    after 500
    set x initial
    update
    set x
} {text}
test fevent-4.2 {FileEventProc procedure: error in read event} {
    proc tkerror args {
    global x
    set x $args
    }
    fileevent $f2 readable {error bogus}
    puts $f2 text; flush $f2
    after 200
    set x initial
    update
    rename tkerror {}
    list $x [fileevent $f2 readable]
} {bogus {}}
test fevent-4.3 {FileEventProc procedure: normal write event} {
    fileevent $f2 writable {
    lappend x "triggered"
    incr count -1
    if {$count <= 0} {
        fileevent $f2 writable {}
    }
    }
    set x initial
    set count 3
    update
    set x
} {initial triggered triggered triggered}
test fevent-4.4 {FileEventProc procedure: eror in write event} {
    proc tkerror args {
    global x
    set x $args
    }
    fileevent $f2 writable {error bad-write}
    set x initial
    update
    rename tkerror {}
    list $x [fileevent $f2 writable]
} {bad-write {}}
test fevent-4.5 {FileEventProc procedure: end of file} {
    set f4 [open {|cat << foo} r]
    fileevent $f4 readable {
    if {[gets $f4 line] < 0} {
        lappend x eof
        fileevent $f4 readable {}
    } else {
        lappend x $line
    }
    }
    after 200
    set x initial
    update
    close $f4
    set x
} {initial foo eof}

close $f
close $f2
close $f3
exec echo foo bar > foo
test fevent-5.1 {DeleteFileEvent, cleanup on close} {
    set f [open foo r]
    fileevent $f readable {
    lappend x "binding triggered: \"[gets $f]\""
    fileevent $f readable {}
    }
    close $f
    set x initial
    update
    set x
} {initial}
test fevent-5.2 {DeleteFileEvent, cleanup on close} {
    set f [open foo r]
    set f2 [open foo r]
    fileevent $f readable {
        lappend x "f triggered: \"[gets $f]\""
        fileevent $f readable {}
    }
    fileevent $f2 readable {
    lappend x "f2 triggered: \"[gets $f2]\""
    fileevent $f2 readable {}
    }
    close $f
    set x initial
    update
    close $f2
    set x
} {initial {f2 triggered: "foo bar"}}
test fevent-5.3 {DeleteFileEvent, cleanup on close} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    fileevent $f readable {f script}
    fileevent $f2 readable {f2 script}
    fileevent $f3 readable {f3 script}
    set x {}
    close $f2
    lappend x [catch {fileevent $f readable} msg] $msg \
        [catch {fileevent $f2 readable}] \
        [catch {fileevent $f3 readable} msg] $msg
    close $f3
    lappend x [catch {fileevent $f readable} msg] $msg \
        [catch {fileevent $f2 readable}] \
        [catch {fileevent $f3 readable}]
    close $f
    lappend x [catch {fileevent $f readable}] \
        [catch {fileevent $f2 readable}] \
        [catch {fileevent $f3 readable}]
} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}

if {[info commands testfevent] == "testfevent"} {
    test fevent-6.1 {Tk_EventInit procedure} {
    testfevent create
    testfevent cmd {
        set f [open foo r]
        set x "no event"
        fileevent $f readable {
        set x "f triggered: [gets $f]"
        fileevent $f readable {}
        }
    }
    update
    testfevent cmd {close $f}
    list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
    } {{f triggered: foo bar} after}
    test fevent-6.2 {Tk_EventInit procedure} {
    testfevent create
    list [catch {testfevent cmd {tkwait window .x}} msg] $msg]
    } {1 {bad option "window": must be variable]}}
    test fevent-6.3 {Tk_EventInit procedure} {
    testfevent create
    list [catch {testfevent cmd {tkwait visibility .x}} msg] $msg]
    } {1 {bad option "visibility": must be variable]}}
    test fevent-6.4 {Tk_EventInit procedure} {
    testfevent create
    testfevent cmd {
        set x 0
        after 10 {set x triggered}
        tkwait variable x
        set x
    }
    } {triggered}
    test fevent-6.5 {Tk_EventInit procedure} {
    testfevent create
    testfevent cmd {
        set x 0
        after 10 {lappend x timer}
        after 30
        set result $x
        update idletasks
        lappend result $x
        update
        lappend result $x
    }
    } {0 0 {0 timer}}
    test fevent-6.6 {Tk_EventInit procedure} {
    button .b -text "Test button"
    place .b -x 5 -y 10
    update
    bind .b <Expose> {lappend x exposed}
    set x initial
    place .b -height 100
    testfevent create
    testfevent cmd {
        update
    }
    lappend x |
    update
    # destroy .b
    set x
    } {initial | exposed}

    test fevent-7.1 {TkEventCleanupProc procedure} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent cmd "fileevent $f2 readable {script 2}"
    fileevent $f3 readable {sript 3}
    set x {}
    lappend x [fileevent $f2 readable]
    testfevent delete
    lappend x [fileevent $f readable] [fileevent $f2 readable] \
        [fileevent $f3 readable]
    close $f
    close $f2
    close $f3
    set x
    } {{script 2} {script 1} {} {sript 3}}
    test fevent-7.2 {TkEventCleanupProc procedure} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    set f4 [open foo r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent cmd "fileevent $f2 readable {script 2}
        fileevent $f3 readable {script 3}"
    fileevent $f4 readable {script 4}
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
        [fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
    } {{script 1} {} {} {script 4}}
    test fevent-7.3 {TkEventCleanupProc procedure} {
    set f [open foo r]
    set f2 [open foo r]
    set f3 [open foo r]
    set f4 [open foo r]
    testfevent create
    fileevent $f readable {script 1}
    fileevent $f2 readable {script 2}
    testfevent cmd "fileevent $f3 readable {script 3}
        fileevent $f4 readable {script 4}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
        [fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
    } {{script 1} {script 2} {} {}}
    test fevent-7.4 {TkEventCleanupProc procedure} {
    set f [open foo r+]
    testfevent create
    fileevent $f readable {read script}
    testfevent cmd "fileevent $f writable {write script}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f writable]]
    close $f
    set x
    } {{read script} {}}
    test fevent-7.5 {TkEventCleanupProc procedure} {
    set f [open foo r+]
    testfevent create
    fileevent $f writable {write script}
    testfevent cmd "fileevent $f readable {read script}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f writable]]
    close $f
    set x
    } {{} {write script}}
    test fevent-7.6 {TkEventCleanupProc procedure} {
    set f [open foo r+]
    testfevent create
    testfevent cmd "fileevent $f readable {read script}
        fileevent $f writable {write script}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f writable]]
    close $f
    set x
    } {{} {}}
    testfevent delete
}
exec rm foo