Import Tk 8.6.6 (as of svn r86089)

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