* Merged 8.1 branch into the main trunk

1 files changed, 97 insertions, 0 deletions

diff --git a/tests/get.test b/tests/get.test
new file mode 100644
index 0000000..bf6dc44
--- /dev/null
+++ b/tests/get.test
@@ -0,0 +1,97 @@
+# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: get.test,v 1.2 1999/04/16 01:51:38 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+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}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+