diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/bell.test | 59 | ||||
| -rw-r--r-- | tests/bgerror.test | 47 |
2 files changed, 61 insertions, 45 deletions
diff --git a/tests/bell.test b/tests/bell.test index 455eb76..b110619 100644 --- a/tests/bell.test +++ b/tests/bell.test @@ -5,34 +5,42 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: bell.test,v 1.8 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: bell.test,v 1.9 2008/07/22 11:39:08 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test bell-1.1 {bell command} { - list [catch {bell a} msg] $msg -} {1 {bad option "a": must be -displayof or -nice}} -test bell-1.2 {bell command} { - list [catch {bell a b} msg] $msg -} {1 {bad option "a": must be -displayof or -nice}} -test bell-1.3 {bell command} { - list [catch {bell -displayof gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test bell-1.4 {bell command} { - list [catch {bell -nice -displayof} msg] $msg -} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} -test bell-1.5 {bell command} { - list [catch {bell -nice -nice -nice} msg] $msg -} {0 {}} -test bell-1.6 {bell command} { - list [catch {bell -displayof . -nice} msg] $msg -} {0 {}} -test bell-1.7 {bell command} { - list [catch {bell -nice -displayof . -nice} msg] $msg -} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} -test bell-1.8 {bell command} { +test bell-1.1 {bell command} -body { + bell a +} -returnCodes {error} -result {bad option "a": must be -displayof or -nice} + +test bell-1.2 {bell command} -body { + bell a b +} -returnCodes {error} -result {bad option "a": must be -displayof or -nice} + +test bell-1.3 {bell command} -body { + bell -displayof gorp +} -returnCodes {error} -result {bad window path name "gorp"} + +test bell-1.4 {bell command} -body { + bell -nice -displayof +} -returnCodes {error} -result {wrong # args: should be "bell ?-displayof window? ?-nice?"} + +test bell-1.5 {bell command} -body { + bell -nice -nice -nice +} -returnCodes {ok} -result {} ;#keep -result {} and -retutnCodes {ok} for clarity? + +test bell-1.6 {bell command} -body { + bell -displayof . -nice +} -returnCodes {ok} -result {} + +test bell-1.7 {bell command} -body { + bell -nice -displayof . -nice +} -returnCodes {error} -result {wrong # args: should be "bell ?-displayof window? ?-nice?"} + +test bell-1.8 {bell command} -body { puts "Bell should ring now ..." flush stdout after 200 @@ -41,8 +49,7 @@ test bell-1.8 {bell command} { bell -nice after 200 bell -} {} +} -result {} -# cleanup cleanupTests return diff --git a/tests/bgerror.test b/tests/bgerror.test index 7d35862..6148c71 100644 --- a/tests/bgerror.test +++ b/tests/bgerror.test @@ -5,51 +5,60 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: bgerror.test,v 1.6 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: bgerror.test,v 1.7 2008/07/22 11:48:24 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test bgerror-1.1 {bgerror / tkerror compat} { +test bgerror-1.1 {bgerror / tkerror compat} -setup { set errRes {} proc tkerror {err} { - global errRes; - set errRes $err; + global errRes; + set errRes $err; } +} -body { after 0 {error err1} vwait errRes; - set errRes; -} err1 + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1} -test bgerror-1.2 {bgerror / tkerror compat / accumulation} { +test bgerror-1.2 {bgerror / tkerror compat / accumulation} -setup { set errRes {} proc tkerror {err} { - global errRes; - lappend errRes $err; + global errRes; + lappend errRes $err; } +} -body { after 0 {error err1} after 0 {error err2} after 0 {error err3} update - set errRes; -} {err1 err2 err3} + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1 err2 err3} -test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} { +test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} -setup { set errRes {} proc tkerror {err} { - global errRes; - lappend errRes $err; - return -code break "skip!"; + global errRes; + lappend errRes $err; + return -code break "skip!"; } +} -body { after 0 {error err1} after 0 {error err2} after 0 {error err3} update - set errRes; -} err1 + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1} -catch {rename tkerror {}} # some testing of the default error dialog # would be needed too, but that's not easy at all |