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