# 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.1.1.1 2007/07/10 15:05:18 duncan Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands 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