1# This file is a Tcl script to test the bgerror command.
2# It is organized in the standard fashion for Tcl tests.
3#
4# Copyright (c) 1997 Sun Microsystems, Inc.
5# Copyright (c) 1998-1999 by Scriptics Corporation.
6# All rights reserved.
7#
8# RCS: @(#) $Id: bgerror.test,v 1.4 2002/07/14 05:48:45 dgp Exp $
9
10package require tcltest 2.1
11namespace import -force tcltest::configure
12namespace import -force tcltest::testsDirectory
13configure -testdir [file join [pwd] [file dirname [info script]]]
14configure -loadfile [file join [testsDirectory] constraints.tcl]
15tcltest::loadTestedCommands
16
17test bgerror-1.1 {bgerror / tkerror compat} {
18    set errRes {}
19    proc tkerror {err} {
20	global errRes;
21	set errRes $err;
22    }
23    after 0 {error err1}
24    vwait errRes;
25    set errRes;
26} err1
27
28test bgerror-1.2 {bgerror / tkerror compat / accumulation} {
29    set errRes {}
30    proc tkerror {err} {
31	global errRes;
32	lappend errRes $err;
33    }
34    after 0 {error err1}
35    after 0 {error err2}
36    after 0 {error err3}
37    update
38    set errRes;
39} {err1 err2 err3}
40
41test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} {
42    set errRes {}
43    proc tkerror {err} {
44	global errRes;
45	lappend errRes $err;
46	return -code break "skip!";
47    }
48    after 0 {error err1}
49    after 0 {error err2}
50    after 0 {error err3}
51    update
52    set errRes;
53} err1
54
55catch {rename tkerror {}}
56
57# some testing of the default error dialog
58# would be needed too, but that's not easy at all
59# to emulate.
60
61# cleanup
62::tcltest::cleanupTests
63return
64
65
66
67
68
69
70
71
72
73
74
75
76
77