util.test
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:2k
- # 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.
- # Copyright (c) 1998-1999 by Scriptics Corporation.
- # All rights reserved.
- #
- # RCS: @(#) $Id: util.test,v 1.5 2002/07/13 20:28:36 dgp Exp $
- package require tcltest 2.1
- namespace import -force tcltest::configure
- namespace import -force tcltest::testsDirectory
- configure -testdir [file join [pwd] [file dirname [info script]]]
- configure -loadfile [file join [testsDirectory] constraints.tcl]
- tcltest::loadTestedCommands
- 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}}
- # cleanup
- ::tcltest::cleanupTests
- return