Update to tcltest2

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