summaryrefslogtreecommitdiffstats
path: root/tk8.6/tests/bgerror.test
diff options
context:
space:
mode:
Diffstat (limited to 'tk8.6/tests/bgerror.test')
-rw-r--r--tk8.6/tests/bgerror.test67
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