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