summaryrefslogtreecommitdiffstats
path: root/tests/message.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/message.test')
-rw-r--r--tests/message.test536
1 files changed, 445 insertions, 91 deletions
diff --git a/tests/message.test b/tests/message.test
index c9ad03d..b548b97 100644
--- a/tests/message.test
+++ b/tests/message.test
@@ -6,117 +6,471 @@
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#
-# RCS: @(#) $Id: message.test,v 1.4 2008/07/23 23:24:25 nijtmans Exp $
+# RCS: @(#) $Id: message.test,v 1.5 2008/07/28 11:12:32 aniap Exp $
-package require tcltest 2.1
-eval tcltest::configure $argv
+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"}
-option add *Message.borderWidth 2
-option add *Message.highlightThickness 2
-option add *Message.font {Helvetica -12 bold}
-
-message .m
-pack .m
-update
-set i 0
-foreach test {
- {-anchor w w bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
- {-aspect 3 3 bogus {expected integer but got "bogus"}}
- {-background #ff0000 #ff0000 non-existent
- {unknown color name "non-existent"}}
- {-bd 4 4 badValue {bad screen distance "badValue"}}
- {-bg #ff0000 #ff0000 non-existent
- {unknown color name "non-existent"}}
- {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
- {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
- {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
- {-font fixed fixed {} {font "" doesn't exist}}
- {-foreground green green badValue {unknown color name "badValue"}}
- {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
- {-highlightcolor #123456 #123456 non-existent
- {unknown color name "non-existent"}}
- {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
- {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
- {-padx 12m 12m 420x {bad screen distance "420x"}}
- {-pady 12m 12m 420x {bad screen distance "420x"}}
- {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
- {-text "Sample text" {Sample text} {} {} {1 1 1 1}}
- {-textvariable i i {} {} {1 1 1 1}}
- {-width 32 32 badValue {bad screen distance "badValue"}}
-} {
- set name [lindex $test 0]
- test message-1.$i {configuration options} {
- .m configure $name [lindex $test 1]
- lindex [.m configure $name] 4
- } [lindex $test 2]
- incr i
- if {[lindex $test 3] != ""} {
- test message-1.$i {configuration options} {
- list [catch {.m configure $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
- }
- .m configure $name [lindex [.m configure $name] 3]
- incr i
-}
-destroy .m
-
-test message-2.1 {Tk_MessageObjCmd procedure} {
- list [catch {message} msg] $msg
-} {1 {wrong # args: should be "message pathName ?-option value ...?"}}
-test message-2.2 {Tk_MessageObjCmd procedure} {
- list [catch {message foo} msg] $msg [winfo child .]
-} {1 {bad window path name "foo"} {}}
-test message-2.3 {Tk_MessageObjCmd procedure} {
- list [catch {message .s -gorp dumb} msg] $msg [winfo child .]
-} {1 {unknown option "-gorp"} {}}
-
-test message-3.1 {MessageWidgetObjCmd procedure} {
+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
- set result [list [catch {.m} msg] $msg]
+} -body {
+ .m
+} -cleanup {
destroy .m
- set result
-} {1 {wrong # args: should be ".m option ?arg ...?"}}
-test message-3.2 {MessageWidgetObjCmd procedure, "cget"} {
+} -returnCodes error -result {wrong # args: should be ".m option ?arg ...?"}
+test message-3.2 {MessageWidgetObjCmd procedure, "cget"} -setup {
message .m
- set result [list [catch {.m cget} msg] $msg]
+} -body {
+ .m cget
+} -cleanup {
destroy .m
- set result
-} {1 {wrong # args: should be ".m cget option"}}
-test message-3.3 {MessageWidgetObjCmd procedure, "cget"} {
+} -returnCodes error -result {wrong # args: should be ".m cget option"}
+test message-3.3 {MessageWidgetObjCmd procedure, "cget"} -setup {
message .m
- set result [list [catch {.m cget -gorp} msg] $msg]
+} -body {
+ .m cget -gorp
+} -cleanup {
destroy .m
- set result
-} {1 {unknown option "-gorp"}}
-test message-3.4 {MessageWidgetObjCmd procedure, "cget"} {
+} -returnCodes error -result {unknown option "-gorp"}
+
+test message-3.4 {MessageWidgetObjCmd procedure, "configure"} -setup {
message .m
+} -body {
.m configure -text foobar
- set result [.m cget -text]
+ lindex [.m configure -text] 4
+} -cleanup {
destroy .m
- set result
-} "foobar"
-test message-3.5 {MessageWidgetObjCmd procedure, "configure"} {
+} -result {foobar}
+test message-3.5 {MessageWidgetObjCmd procedure, "configure"} -setup {
message .m
- set result [llength [.m configure]]
+} -body {
+ llength [.m configure]
+} -cleanup {
destroy .m
- set result
-} 21
-test message-3.6 {MessageWidgetObjCmd procedure, "configure"} {
+} -result {21}
+test message-3.6 {MessageWidgetObjCmd procedure, "configure"} -setup {
message .m
- set result [list [catch {.m configure -foo} msg] $msg]
+} -body {
+ .m configure -foo
+} -cleanup {
destroy .m
- set result
-} {1 {unknown option "-foo"}}
-test message-3.7 {MessageWidgetObjCmd procedure, "configure"} {
+} -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
- set result [lindex [.m configure -bd] 4]
+ lindex [.m configure -bd] 4
+} -cleanup {
destroy .m
- set result
-} {4}
+} -result {4}
-# cleanup
cleanupTests
return