Initial revision

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.
+