1# This file is a Tcl script to test out the procedures in the file
2# tkGet.c.  It is organized in the standard fashion for Tcl
3# white-box tests.
4#
5# Copyright (c) 1998 Sun Microsystems, Inc.
6# Copyright (c) 1998-1999 by Scriptics Corporation.
7# All rights reserved.
8#
9# RCS: @(#) $Id: get.test,v 1.3 2002/07/13 21:52:34 dgp Exp $
10
11package require tcltest 2.1
12namespace import -force tcltest::configure
13namespace import -force tcltest::testsDirectory
14configure -testdir [file join [pwd] [file dirname [info script]]]
15configure -loadfile [file join [testsDirectory] constraints.tcl]
16tcltest::loadTestedCommands
17
18button .b
19test get-1.1 {Tk_GetAnchorFromObj} {
20    .b configure -anchor n
21    .b cget -anchor
22} {n}
23test get-1.2 {Tk_GetAnchorFromObj} {
24    .b configure -anchor ne
25    .b cget -anchor
26} {ne}
27test get-1.3 {Tk_GetAnchorFromObj} {
28    .b configure -anchor e
29    .b cget -anchor
30} {e}
31test get-1.4 {Tk_GetAnchorFromObj} {
32    .b configure -anchor se
33    .b cget -anchor
34} {se}
35test get-1.5 {Tk_GetAnchorFromObj} {
36    .b configure -anchor s
37    .b cget -anchor
38} {s}
39test get-1.6 {Tk_GetAnchorFromObj} {
40    .b configure -anchor sw
41    .b cget -anchor
42} {sw}
43test get-1.7 {Tk_GetAnchorFromObj} {
44    .b configure -anchor w
45    .b cget -anchor
46} {w}
47test get-1.8 {Tk_GetAnchorFromObj} {
48    .b configure -anchor nw
49    .b cget -anchor
50} {nw}
51test get-1.9 {Tk_GetAnchorFromObj} {
52    .b configure -anchor n
53    .b cget -anchor
54} {n}
55test get-1.10 {Tk_GetAnchorFromObj} {
56    .b configure -anchor center
57    .b cget -anchor
58} {center}
59test get-1.11 {Tk_GetAnchorFromObj - error} {
60    list [catch {.b configure -anchor unknown} msg] $msg
61} {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}}
62
63catch {destroy .b}
64button .b
65test get-2.1 {Tk_GetJustifyFromObj} {
66    .b configure -justify left
67    .b cget -justify
68} {left}
69test get-2.2 {Tk_GetJustifyFromObj} {
70    .b configure -justify right
71    .b cget -justify
72} {right}
73test get-2.3 {Tk_GetJustifyFromObj} {
74    .b configure -justify center
75    .b cget -justify
76} {center}
77test get-2.4 {Tk_GetJustifyFromObj - error} {
78    list [catch {.b configure -justify stupid} msg] $msg
79} {1 {bad justification "stupid": must be left, right, or center}}
80
81# cleanup
82::tcltest::cleanupTests
83return
84
85
86
87
88
89
90
91
92
93
94
95
96
97