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