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