1# This file is a Tcl script to test out the "message" command 2# of Tk. It is organized in the standard fashion for Tcl tests. 3# 4# Copyright (c) 1994 The Regents of the University of California. 5# Copyright (c) 1994-1996 Sun Microsystems, Inc. 6# Copyright (c) 1998-2000 by Ajuba Solutions. 7# All rights reserved. 8# 9# RCS: @(#) $Id$ 10 11package require tcltest 2.1 12eval tcltest::configure $argv 13tcltest::loadTestedCommands 14 15option add *Message.borderWidth 2 16option add *Message.highlightThickness 2 17option add *Message.font {Helvetica -12 bold} 18 19message .m 20pack .m 21update 22set i 0 23foreach test { 24 {-anchor w w bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} 25 {-aspect 3 3 bogus {expected integer but got "bogus"}} 26 {-background #ff0000 #ff0000 non-existent 27 {unknown color name "non-existent"}} 28 {-bd 4 4 badValue {bad screen distance "badValue"}} 29 {-bg #ff0000 #ff0000 non-existent 30 {unknown color name "non-existent"}} 31 {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} 32 {-cursor arrow arrow badValue {bad cursor spec "badValue"}} 33 {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}} 34 {-font fixed fixed {} {font "" doesn't exist}} 35 {-foreground green green badValue {unknown color name "badValue"}} 36 {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} 37 {-highlightcolor #123456 #123456 non-existent 38 {unknown color name "non-existent"}} 39 {-highlightthickness 2 2 badValue {bad screen distance "badValue"}} 40 {-justify right right bogus {bad justification "bogus": must be left, right, or center}} 41 {-padx 12m 12m 420x {bad screen distance "420x"}} 42 {-pady 12m 12m 420x {bad screen distance "420x"}} 43 {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} 44 {-text "Sample text" {Sample text} {} {} {1 1 1 1}} 45 {-textvariable i i {} {} {1 1 1 1}} 46 {-width 32 32 badValue {bad screen distance "badValue"}} 47} { 48 set name [lindex $test 0] 49 test message-1.$i {configuration options} { 50 .m configure $name [lindex $test 1] 51 lindex [.m configure $name] 4 52 } [lindex $test 2] 53 incr i 54 if {[lindex $test 3] != ""} { 55 test message-1.$i {configuration options} { 56 list [catch {.m configure $name [lindex $test 3]} msg] $msg 57 } [list 1 [lindex $test 4]] 58 } 59 .m configure $name [lindex [.m configure $name] 3] 60 incr i 61} 62destroy .m 63 64test message-2.1 {Tk_MessageObjCmd procedure} { 65 list [catch {message} msg] $msg 66} {1 {wrong # args: should be "message pathName ?options?"}} 67test message-2.2 {Tk_MessageObjCmd procedure} { 68 list [catch {message foo} msg] $msg [winfo child .] 69} {1 {bad window path name "foo"} {}} 70test message-2.3 {Tk_MessageObjCmd procedure} { 71 list [catch {message .s -gorp dumb} msg] $msg [winfo child .] 72} {1 {unknown option "-gorp"} {}} 73 74test message-3.1 {MessageWidgetObjCmd procedure} { 75 message .m 76 set result [list [catch {.m} msg] $msg] 77 destroy .m 78 set result 79} {1 {wrong # args: should be ".m option ?arg arg ...?"}} 80test message-3.2 {MessageWidgetObjCmd procedure, "cget"} { 81 message .m 82 set result [list [catch {.m cget} msg] $msg] 83 destroy .m 84 set result 85} {1 {wrong # args: should be ".m cget option"}} 86test message-3.3 {MessageWidgetObjCmd procedure, "cget"} { 87 message .m 88 set result [list [catch {.m cget -gorp} msg] $msg] 89 destroy .m 90 set result 91} {1 {unknown option "-gorp"}} 92test message-3.4 {MessageWidgetObjCmd procedure, "cget"} { 93 message .m 94 .m configure -text foobar 95 set result [.m cget -text] 96 destroy .m 97 set result 98} "foobar" 99test message-3.5 {MessageWidgetObjCmd procedure, "configure"} { 100 message .m 101 set result [llength [.m configure]] 102 destroy .m 103 set result 104} 21 105test message-3.6 {MessageWidgetObjCmd procedure, "configure"} { 106 message .m 107 set result [list [catch {.m configure -foo} msg] $msg] 108 destroy .m 109 set result 110} {1 {unknown option "-foo"}} 111test message-3.7 {MessageWidgetObjCmd procedure, "configure"} { 112 message .m 113 .m configure -bd 4 114 .m configure -bg #ffffff 115 set result [lindex [.m configure -bd] 4] 116 destroy .m 117 set result 118} {4} 119 120# cleanup 121cleanupTests 122return 123