summaryrefslogtreecommitdiffstats
path: root/tests/get.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/get.test')
-rw-r--r--tests/get.test81
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}}