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$ 9 10package require tcltest 2.1 11eval tcltest::configure $argv 12tcltest::loadTestedCommands 13 14test bell-1.1 {bell command} { 15 list [catch {bell a} msg] $msg 16} {1 {bad option "a": must be -displayof or -nice}} 17test bell-1.2 {bell command} { 18 list [catch {bell a b} msg] $msg 19} {1 {bad option "a": must be -displayof or -nice}} 20test bell-1.3 {bell command} { 21 list [catch {bell -displayof gorp} msg] $msg 22} {1 {bad window path name "gorp"}} 23test bell-1.4 {bell command} { 24 list [catch {bell -nice -displayof} msg] $msg 25} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} 26test bell-1.5 {bell command} { 27 list [catch {bell -nice -nice -nice} msg] $msg 28} {0 {}} 29test bell-1.6 {bell command} { 30 list [catch {bell -displayof . -nice} msg] $msg 31} {0 {}} 32test bell-1.7 {bell command} { 33 list [catch {bell -nice -displayof . -nice} msg] $msg 34} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} 35test bell-1.8 {bell command} { 36 puts "Bell should ring now ..." 37 flush stdout 38 after 200 39 bell -displayof . 40 after 200 41 bell -nice 42 after 200 43 bell 44} {} 45 46# cleanup 47cleanupTests 48return 49