diff options
Diffstat (limited to 'tests/get.test')
-rw-r--r-- | tests/get.test | 81 |
1 files changed, 81 insertions, 0 deletions
diff --git a/tests/get.test b/tests/get.test new file mode 100644 index 0000000..9c57128 --- /dev/null +++ b/tests/get.test @@ -0,0 +1,81 @@ +# This file is a Tcl script to test out the procedures in the file +# tkGet.c. It is organized in the standard fashion for Tcl +# white-box tests. +# +# Copyright (c) 1998 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: @(#) get.test 1.1 97/12/24 16:16:50 + +if {[info procs test] != "test"} { + source defs +} + +eval destroy [winfo children .] +wm geometry . {} +raise . + +button .b +test get-1.1 {Tk_GetAnchorFromObj} { + .b configure -anchor n + .b cget -anchor +} {n} +test get-1.2 {Tk_GetAnchorFromObj} { + .b configure -anchor ne + .b cget -anchor +} {ne} +test get-1.3 {Tk_GetAnchorFromObj} { + .b configure -anchor e + .b cget -anchor +} {e} +test get-1.4 {Tk_GetAnchorFromObj} { + .b configure -anchor se + .b cget -anchor +} {se} +test get-1.5 {Tk_GetAnchorFromObj} { + .b configure -anchor s + .b cget -anchor +} {s} +test get-1.6 {Tk_GetAnchorFromObj} { + .b configure -anchor sw + .b cget -anchor +} {sw} +test get-1.7 {Tk_GetAnchorFromObj} { + .b configure -anchor w + .b cget -anchor +} {w} +test get-1.8 {Tk_GetAnchorFromObj} { + .b configure -anchor nw + .b cget -anchor +} {nw} +test get-1.9 {Tk_GetAnchorFromObj} { + .b configure -anchor n + .b cget -anchor +} {n} +test get-1.10 {Tk_GetAnchorFromObj} { + .b configure -anchor center + .b cget -anchor +} {center} +test get-1.11 {Tk_GetAnchorFromObj - error} { + list [catch {.b configure -anchor unknown} msg] $msg +} {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}} + +catch {destroy .b} +button .b +test get-2.1 {Tk_GetJustifyFromObj} { + .b configure -justify left + .b cget -justify +} {left} +test get-2.2 {Tk_GetJustifyFromObj} { + .b configure -justify right + .b cget -justify +} {right} +test get-2.3 {Tk_GetJustifyFromObj} { + .b configure -justify center + .b cget -justify +} {center} +test get-2.4 {Tk_GetJustifyFromObj - error} { + list [catch {.b configure -justify stupid} msg] $msg +} {1 {bad justification "stupid": must be left, right, or center}} |