# 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