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