diff options
Diffstat (limited to 'tk8.6/tests/bgerror.test')
-rw-r--r-- | tk8.6/tests/bgerror.test | 67 |
1 files changed, 67 insertions, 0 deletions
diff --git a/tk8.6/tests/bgerror.test b/tk8.6/tests/bgerror.test new file mode 100644 index 0000000..fd9594a --- /dev/null +++ b/tk8.6/tests/bgerror.test @@ -0,0 +1,67 @@ +# 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. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. + +package require tcltest 2.2 +namespace import ::tcltest::* +eval tcltest::configure $argv +tcltest::loadTestedCommands + +test bgerror-1.1 {bgerror / tkerror compat} -setup { + set errRes {} + proc tkerror {err} { + global errRes; + set errRes $err; + } +} -body { + after 0 {error err1} + vwait errRes; + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1} + +test bgerror-1.2 {bgerror / tkerror compat / accumulation} -setup { + set errRes {} + proc tkerror {err} { + global errRes; + lappend errRes $err; + } +} -body { + after 0 {error err1} + after 0 {error err2} + after 0 {error err3} + update + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1 err2 err3} + +test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} -setup { + set errRes {} + proc tkerror {err} { + global errRes; + lappend errRes $err; + return -code break "skip!"; + } +} -body { + after 0 {error err1} + after 0 {error err2} + after 0 {error err3} + update + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1} + + +# some testing of the default error dialog +# would be needed too, but that's not easy at all +# to emulate. + +# cleanup +cleanupTests +return |