diff options
Diffstat (limited to 'tests/bgerror.test')
| -rw-r--r-- | tests/bgerror.test | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/tests/bgerror.test b/tests/bgerror.test new file mode 100644 index 0000000..72b5400 --- /dev/null +++ b/tests/bgerror.test @@ -0,0 +1,59 @@ +# This file is a Tcl script to test the bgerror command. +# It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1997 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) bgerror.test 1.1 97/08/06 09:28:30 + +if {[info commands test] == ""} { + source defs +} + + +test bgerror-1.1 {bgerror / tkerror compat} { + set errRes {} + proc tkerror {err} { + global errRes; + set errRes $err; + } + after 0 {error err1} + vwait errRes; + set errRes; +} err1 + +test bgerror-1.2 {bgerror / tkerror compat / accumulation} { + set errRes {} + proc tkerror {err} { + global errRes; + lappend errRes $err; + } + after 0 {error err1} + after 0 {error err2} + after 0 {error err3} + update + set errRes; +} {err1 err2 err3} + +test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} { + set errRes {} + proc tkerror {err} { + global errRes; + lappend errRes $err; + return -code break "skip!"; + } + after 0 {error err1} + after 0 {error err2} + after 0 {error err3} + update + set errRes; +} err1 + +catch {rename tkerror {}} + +# some testing of the default error dialog +# would be needed too, but that's not easy at all +# to emulate. + |