# 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