1# This file is a Tcl script to test out Tk's "bell" command. 2# It is organized in the standard fashion for Tcl tests. 3# 4# Copyright (c) 1994 The Regents of the University of California. 5# Copyright (c) 1998-2000 by Scriptics Corporation. 6# All rights reserved. 7# 8# RCS: @(#) $Id: bell.test,v 1.6 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 bell-1.1 {bell command} { 18 list [catch {bell a} msg] $msg 19} {1 {bad option "a": must be -displayof or -nice}} 20test bell-1.2 {bell command} { 21 list [catch {bell a b} msg] $msg 22} {1 {bad option "a": must be -displayof or -nice}} 23test bell-1.3 {bell command} { 24 list [catch {bell -displayof gorp} msg] $msg 25} {1 {bad window path name "gorp"}} 26test bell-1.4 {bell command} { 27 list [catch {bell -nice -displayof} msg] $msg 28} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} 29test bell-1.5 {bell command} { 30 list [catch {bell -nice -nice -nice} msg] $msg 31} {0 {}} 32test bell-1.6 {bell command} { 33 list [catch {bell -displayof . -nice} msg] $msg 34} {0 {}} 35test bell-1.7 {bell command} { 36 list [catch {bell -nice -displayof . -nice} msg] $msg 37} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} 38test bell-1.8 {bell command} { 39 puts "Bell should ring now ..." 40 flush stdout 41 after 200 42 bell -displayof . 43 after 200 44 bell -nice 45 after 200 46 bell 47} {} 48 49# cleanup 50::tcltest::cleanupTests 51return 52 53 54 55 56 57 58 59 60 61 62 63 64 65