# This file is a Tcl script to test out the "message" command
# of Tk. It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
package require tcltest 2.2
namespace import ::tcltest::*
tcltest::loadTestedCommands
eval tcltest::configure $argv
test message-1.1 {configuration option: "anchor"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -anchor w
.m cget -anchor
} -cleanup {
destroy .m
} -result {w}
test message-1.2 {configuration option: "anchor"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -anchor bogus
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}
test message-1.3 {configuration option: "aspect"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -aspect 3
.m cget -aspect
} -cleanup {
destroy .m
} -result {3}
test message-1.4 {configuration option: "aspect"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -aspect bogus
} -cleanup {
destroy .m
} -returnCodes {error} -result {expected integer but got "bogus"}
test message-1.5 {configuration option: "background"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -background #ff0000
.m cget -background
} -cleanup {
destroy .m
} -result {#ff0000}
test message-1.6 {configuration option: "background"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -background non-existent
} -cleanup {
destroy .m
} -returnCodes {error} -result {unknown color name "non-existent"}
test message-1.7 {configuration option: "bd"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -bd 4
.m cget -bd
} -cleanup {
destroy .m
} -result {4}
test message-1.8 {configuration option: "bd"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -bd badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad screen distance "badValue"}
test message-1.9 {configuration option: "bg"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -bg #ff0000
.m cget -bg
} -cleanup {
destroy .m
} -result {#ff0000}
test message-1.10 {configuration option: "bg"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -bg non-existent
} -cleanup {
destroy .m
} -returnCodes {error} -result {unknown color name "non-existent"}
test message-1.11 {configuration option: "borderwidth"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -borderwidth 1.3
.m cget -borderwidth
} -cleanup {
destroy .m
} -result {1}
test message-1.12 {configuration option: "borderwidth"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -borderwidth badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad screen distance "badValue"}
test message-1.13 {configuration option: "cursor"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -cursor arrow
.m cget -cursor
} -cleanup {
destroy .m
} -result {arrow}
test message-1.14 {configuration option: "cursor"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -cursor badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad cursor spec "badValue"}
test message-1.15 {configuration option: "fg"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -fg #00ff00
.m cget -fg
} -cleanup {
destroy .m
} -result {#00ff00}
test message-1.16 {configuration option: "fg"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -fg badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {unknown color name "badValue"}
test message-1.17 {configuration option: "font"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -font fixed
.m cget -font
} -cleanup {
destroy .m
} -result {fixed}
test message-1.18 {configuration option: "font"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -font {}
} -cleanup {
destroy .m
} -returnCodes {error} -result {font "" doesn't exist}
test message-1.19 {configuration option: "-foreground"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -foreground green
.m cget -foreground
} -cleanup {
destroy .m
} -result {green}
test message-1.20 {configuration option: "-foreground"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -foreground badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {unknown color name "badValue"}
test message-1.21 {configuration option: "highlightbackground"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -highlightbackground #112233
.m cget -highlightbackground
} -cleanup {
destroy .m
} -result {#112233}
test message-1.22 {configuration option: "highlightbackground"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -highlightbackground ugly
} -cleanup {
destroy .m
} -returnCodes {error} -result {unknown color name "ugly"}
test message-1.23 {configuration option: "highlightcolor"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -highlightcolor #123456
.m cget -highlightcolor
} -cleanup {
destroy .m
} -result {#123456}
test message-1.24 {configuration option: "highlightcolor"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -highlightcolor non-existent
} -cleanup {
destroy .m
} -returnCodes {error} -result {unknown color name "non-existent"}
test message-1.25 {configuration option: "highlightthickness"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -highlightthickness 2
.m cget -highlightthickness
} -cleanup {
destroy .m
} -result {2}
test message-1.26 {configuration option: "highlightthickness"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -highlightthickness badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad screen distance "badValue"}
test message-1.27 {configuration option: "justify"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -justify right
.m cget -justify
} -cleanup {
destroy .m
} -result {right}
test message-1.28 {configuration option: "justify"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -justify bogus
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center}
test message-1.29 {configuration option: "padx"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -padx 12m
.m cget -padx
} -cleanup {
destroy .m
} -result {12m}
test message-1.30 {configuration option: "padx"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -padx 420x
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad screen distance "420x"}
test message-1.31 {configuration option: "pady"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -pady 12m
.m cget -pady
} -cleanup {
destroy .m
} -result {12m}
test message-1.32 {configuration option: "pady"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -pady 420x
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad screen distance "420x"}
test message-1.33 {configuration option: "relief"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -relief ridge
.m cget -relief
} -cleanup {
destroy .m
} -result {ridge}
test message-1.34 {configuration option: "relief"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -relief badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
test message-1.35 {configuration options: "text"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -text "Sample text"
.m cget -text
} -cleanup {
destroy .m
} -result {Sample text}
test message-1.36 {configuration option: "textvariable"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -textvariable i
.m cget -textvariable
} -cleanup {
destroy .m
} -result {i}
test message-1.37 {configuration option: "width"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -width 2
.m cget -width
} -cleanup {
destroy .m
} -result {2}
test message-1.38 {configuration option: "width"} -setup {
message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .m
update
} -body {
.m configure -width badValue
} -cleanup {
destroy .m
} -returnCodes {error} -result {bad screen distance "badValue"}
test message-2.1 {Tk_MessageObjCmd procedure} -body {
message
} -returnCodes {error} -result {wrong # args: should be "message pathName ?-option value ...?"}
test message-2.2 {Tk_MessageObjCmd procedure} -body {
message foo
} -returnCodes {error} -result {bad window path name "foo"}
test message-2.3 {Tk_MessageObjCmd procedure} -body {
catch {message foo}
winfo child .
} -result {}
test message-2.4 {Tk_MessageObjCmd procedure} -body {
message .s -gorp dump
} -returnCodes {error} -result {unknown option "-gorp"}
test message-2.5 {Tk_MessageObjCmd procedure} -body {
catch {message .s -gorp dump}
winfo child .
} -result {}
test message-3.1 {MessageWidgetObjCmd procedure} -setup {
message .m
} -body {
.m
} -cleanup {
destroy .m
} -returnCodes error -result {wrong # args: should be ".m option ?arg ...?"}
test message-3.2 {MessageWidgetObjCmd procedure, "cget"} -setup {
message .m
} -body {
.m cget
} -cleanup {
destroy .m
} -returnCodes error -result {wrong # args: should be ".m cget option"}
test message-3.3 {MessageWidgetObjCmd procedure, "cget"} -setup {
message .m
} -body {
.m cget -gorp
} -cleanup {
destroy .m
} -returnCodes error -result {unknown option "-gorp"}
test message-3.4 {MessageWidgetObjCmd procedure, "configure"} -setup {
message .m
} -body {
.m configure -text foobar
lindex [.m configure -text] 4
} -cleanup {
destroy .m
} -result {foobar}
test message-3.5 {MessageWidgetObjCmd procedure, "configure"} -setup {
message .m
} -body {
llength [.m configure]
} -cleanup {
destroy .m
} -result {21}
test message-3.6 {MessageWidgetObjCmd procedure, "configure"} -setup {
message .m
} -body {
.m configure -foo
} -cleanup {
destroy .m
} -returnCodes error -result {unknown option "-foo"}
test message-3.7 {MessageWidgetObjCmd procedure, "configure"} -setup {
message .m
} -body {
.m configure -bd 4
.m configure -bg #ffffff
lindex [.m configure -bd] 4
} -cleanup {
destroy .m
} -result {4}
test message-4.1 {Bug [5d991b822e]} {
# Want this not to segfault, or write to variable with empty name
unset -nocomplain {}
set var INIT
message .b -textvariable var
trace add variable var unset {apply {args {
.b configure -textvariable {}
}}}
pack .b
bind .b <Configure> {unset var}
update
destroy .b
info exists {}
} 0
test message-4.2 {Bug [5d991b822e]} {
# Want this not to leak traces
set var INIT
message .b -textvariable var
trace add variable var unset {apply {args {
.b configure -textvariable new
}}}
pack .b
bind .b <Configure> {unset -nocomplain var}
update
destroy .b
unset new
} {}
cleanupTests
return
