diff options
author | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
---|---|---|
committer | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
commit | 9c5b7f2b7e472536ed2e7c915ead05e2aa264182 (patch) | |
tree | 8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /tests/util.test | |
parent | 1d0efcbe267f2c0eb73869862522fb20fb2d63ca (diff) | |
download | tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.zip tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.gz tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.bz2 |
Initial revision
FossilOrigin-Name: 2bf55ca9aa942b581137b9f474da5ad9c1480de4
Diffstat (limited to 'tests/util.test')
-rw-r--r-- | tests/util.test | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/tests/util.test b/tests/util.test new file mode 100644 index 0000000..3b41e49 --- /dev/null +++ b/tests/util.test @@ -0,0 +1,70 @@ +# This file is a Tcl script to test out the procedures in the file +# tkUtil.c. It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) util.test 1.4 96/02/16 10:55:50 + +if {[string compare test [info procs test]] == 1} then \ + {source defs} + +foreach i [winfo children .] { + destroy $i +} +wm geometry . {} +raise . + +listbox .l -width 20 -height 5 -relief sunken -bd 2 +pack .l +.l insert 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +update +test util-1.1 {Tk_GetScrollInfo procedure} { + list [catch {.l yview moveto a b} msg] $msg +} {1 {wrong # args: should be ".l yview moveto fraction"}} +test util-1.2 {Tk_GetScrollInfo procedure} { + list [catch {.l yview moveto xyz} msg] $msg +} {1 {expected floating-point number but got "xyz"}} +test util-1.3 {Tk_GetScrollInfo procedure} { + .l yview 0 + .l yview moveto .5 + .l yview +} {0.5 0.75} +test util-1.4 {Tk_GetScrollInfo procedure} { + list [catch {.l yview scroll a} msg] $msg +} {1 {wrong # args: should be ".l yview scroll number units|pages"}} +test util-1.5 {Tk_GetScrollInfo procedure} { + list [catch {.l yview scroll a b c} msg] $msg +} {1 {wrong # args: should be ".l yview scroll number units|pages"}} +test util-1.6 {Tk_GetScrollInfo procedure} { + list [catch {.l yview scroll xyz units} msg] $msg +} {1 {expected integer but got "xyz"}} +test util-1.7 {Tk_GetScrollInfo procedure} { + .l yview 0 + .l yview scroll 2 pages + .l nearest 0 +} {6} +test util-1.8 {Tk_GetScrollInfo procedure} { + .l yview 15 + .l yview scroll -2 pages + .l nearest 0 +} {9} +test util-1.9 {Tk_GetScrollInfo procedure} { + .l yview 0 + .l yview scroll 2 units + .l nearest 0 +} {2} +test util-1.10 {Tk_GetScrollInfo procedure} { + .l yview 15 + .l yview scroll -2 units + .l nearest 0 +} {13} +test util-1.11 {Tk_GetScrollInfo procedure} { + list [catch {.l yview scroll 3 zips} msg] $msg +} {1 {bad argument "zips": must be units or pages}} +test util-1.12 {Tk_GetScrollInfo procedure} { + list [catch {.l yview dropdead 3 times} msg] $msg +} {1 {unknown option "dropdead": must be moveto or scroll}} |