path: root/tests/ttk/spinbox.test

#
# ttk::spinbox widget tests
#

package require Tk
package require tcltest 2.2
namespace import -force tcltest::*
loadTestedCommands

test spinbox-1.0 "Spinbox tests -- setup" -body {
    ttk::spinbox .sb
} -cleanup { destroy .sb } -result .sb

test spinbox-1.1 "Bad -values list" -setup {
    ttk::spinbox .sb
} -body {
    .sb configure -values "bad \{list"
} -cleanup {
    destroy .sb
} -returnCodes error -result "unmatched open brace in list"

test spinbox-1.3.1 "get retrieves value" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb set 50
    .sb get
} -cleanup {
    destroy .sb
} -result 50

test spinbox-1.3.2 "get retrieves value" -setup {
    ttk::spinbox .sb -from 0 -to 100 -values 55
} -body {
     .sb set 55
    .sb get
} -cleanup {
    destroy .sb
} -result 55

test spinbox-1.4.1 "set changes value" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb set 33
    .sb get
} -cleanup {
    destroy .sb
} -result 33

test spinbox-1.4.2 "set changes value" -setup {
    ttk::spinbox .sb -from 0 -to 100 -values 55
} -body {
    .sb set 33
    .sb get
} -cleanup {
    destroy .sb
} -result 33


test spinbox-1.6.1 "insert start" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb set 5
    .sb insert 0 4
    .sb get
} -cleanup {
    destroy .sb
} -result 45

test spinbox-1.6.2 "insert end" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb set 5
    .sb insert end 4
    .sb get
} -cleanup {
    destroy .sb
} -result 54

test spinbox-1.6.3 "insert invalid index" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb set 5
    .sb insert 100 4
    .sb get
} -cleanup {
    destroy .sb
} -result 54

test spinbox-1.7.1 "-command option: set doesnt fire" -setup {
    ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1}
} -body {
    set ::spinbox_test 0
    .sb set 50
    set ::spinbox_test
} -cleanup {
    destroy .sb
} -result 0

test spinbox-1.7.2 "-command option: button handler will fire" -setup {
    ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1}
} -body {
    set ::spinbox_test 0
    .sb set 50
    event generate .sb <<Increment>>
    set ::spinbox_test
} -cleanup {
    destroy .sb
} -result 1

test spinbox-1.8.1 "option -validate" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb configure -validate all
    .sb cget -validate
} -cleanup {
    destroy .sb
} -result {all}

test spinbox-1.8.2 "option -validate" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb configure -validate key
    .sb configure -validate focus
    .sb configure -validate focusin
    .sb configure -validate focusout
    .sb configure -validate none
    .sb cget -validate
} -cleanup {
    destroy .sb
} -result {none}

test spinbox-1.8.3 "option -validate" -setup {
    ttk::spinbox .sb -from 0 -to 100
} -body {
    .sb configure -validate bogus
} -cleanup {
    destroy .sb
} -returnCodes error -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}

test spinbox-1.8.4 "-validate option: " -setup {
    ttk::spinbox .sb -from 0 -to 100
    set ::spinbox_test {}
} -body {
    .sb configure -validate all -validatecommand {set ::spinbox_test %P}
    pack .sb
    update idletasks
    .sb set 50
    focus -force .sb
    set ::spinbox_wait 0
    set timer [after 100 {set ::spinbox_wait 1}]
    vwait ::spinbox_wait
    after cancel $timer
    set ::spinbox_test
} -cleanup {
    destroy .sb
} -result 50


test spinbox-2.0 "current command -- unset should be 0" -constraints nyi -setup {
    ttk::spinbox .sb -values [list a b c d e a]
} -body {
    .sb current
} -cleanup {
    destroy .sb
} -result 0
# @@@ for combobox, this is -1.

test spinbox-2.1 "current command -- set index" -constraints nyi -setup {
    ttk::spinbox .sb -values [list a b c d e a]
} -body {
    .sb current 5
    .sb get
} -cleanup {
    destroy .sb
} -result a

test spinbox-2.2 "current command -- change -values" -constraints nyi -setup {
    ttk::spinbox .sb -values [list a b c d e a]
} -body {
    .sb current 5
    .sb configure -values [list c b a d e]
    .sb current
} -cleanup {
    destroy .sb
} -result 2

test spinbox-2.3 "current command -- change value" -constraints nyi -setup {
    ttk::spinbox .sb -values [list c b a d e]
} -body {
    .sb current 2
    .sb set "b"
    .sb current
} -cleanup {
    destroy .sb
} -result 1

test spinbox-2.4 "current command -- value not in list" -constraints nyi -setup {
    ttk::spinbox .sb -values [list c b a d e]
} -body {
    .sb current 2
    .sb set "z"
    .sb current
} -cleanup {
    destroy .sb
} -result -1

test spinbox-3.0 "textarea should expand to fill widget" -setup {
    set SBV 5
    set ::spinbox_test {}
    ttk::spinbox .sb -from 0 -to 10 -textvariable SBV
} -body {
    grid columnconfigure . 0 -weight 1
    update idletasks
    set timer [after 500 {set ::spinbox_test timedout}]
    bind . <Map> {
        after idle {
            wm geometry . "210x80"
	    update idletasks
            set ::spinbox_test [.sb identify element 25 5]
        }
        bind . <Map> {}
    }
    grid .sb -sticky ew
    vwait ::spinbox_test
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test SBV
} -result {textarea}

test spinbox-4.0 "Increment with duplicates in -values, wrap" -setup {
    ttk::spinbox .sb -values {one two three 4 5 two six} -wrap true
    set max [expr {[llength [.sb cget -values]] + 2}]
} -body {
    set ::spinbox_test [.sb get]
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Increment>>
        lappend ::spinbox_test [.sb get]
    }
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Decrement>>
        lappend ::spinbox_test [.sb get]
    }
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test max
} -result {one two three 4 5 two six one two one six two 5 4 three two one six}

test spinbox-4.1 "Increment with duplicates in -values, wrap, initial value set" -setup {
    ttk::spinbox .sb -values {one two three 4 5 two six} -wrap true
    set max [expr {[llength [.sb cget -values]] + 2}]
} -body {
    .sb set three
    set ::spinbox_test [.sb get]
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Increment>>
        lappend ::spinbox_test [.sb get]
    }
    .sb set two    ; # the first "two" in the -values list becomes the current value
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Decrement>>
        lappend ::spinbox_test [.sb get]
    }
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test max
} -result {three 4 5 two six one two three 4 5 one six two 5 4 three two one six}

test spinbox-4.2 "Increment with duplicates in -values, no wrap" -setup {
    ttk::spinbox .sb -values {one two three 4 5 two six} -wrap false
    set max [expr {[llength [.sb cget -values]] + 2}]
} -body {
    set ::spinbox_test [.sb get]
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Increment>>
        lappend ::spinbox_test [.sb get]
    }
    for {set i 0} {$i < $max} {incr i} {
        event generate .sb <<Decrement>>
        lappend ::spinbox_test [.sb get]
    }
    set ::spinbox_test
} -cleanup {
    destroy .sb
    unset -nocomplain ::spinbox_test max
} -result {one two three 4 5 two six six six two 5 4 three two one one one one}


# nostomp: NB intentional difference between ttk::spinbox and tk::spinbox;
# see also #1439266
#
test spinbox-nostomp-1 "don't stomp on -variable (init; -from/to)" -body {
    set SBV 55
    ttk::spinbox .sb -textvariable SBV -from 0 -to 100 -increment 5
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list 55 55]

test spinbox-nostomp-2 "don't stomp on -variable (init; -values)" -body {
    set SBV Apr
    ttk::spinbox .sb -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug}
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list Apr Apr]

test spinbox-nostomp-3 "don't stomp on -variable (configure; -from/to)" -body {
    set SBV 55
    ttk::spinbox .sb
    .sb configure -textvariable SBV -from 0 -to 100 -increment 5
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list 55 55]

test spinbox-nostomp-4 "don't stomp on -variable (configure; -values)" -body {
    set SBV Apr
    ttk::spinbox .sb
    .sb configure -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug}
    list $SBV [.sb get]
} -cleanup {
   unset SBV
   destroy .sb
} -result [list Apr Apr]

test spinbox-dieoctaldie-1 "Cope with leading zeros" -body {
    # See SF#2358545 -- ttk::spinbox also affected
    set secs 07
    ttk::spinbox .sb -from 0 -to 59 -format %02.0f -textvariable secs

    set result [list $secs]
    event generate .sb <<Increment>>; lappend result $secs
    event generate .sb <<Increment>>; lappend result $secs
    event generate .sb <<Increment>>; lappend result $secs
    event generate .sb <<Increment>>; lappend result $secs

    event generate .sb <<Decrement>>; lappend result $secs
    event generate .sb <<Decrement>>; lappend result $secs
    event generate .sb <<Decrement>>; lappend result $secs
    event generate .sb <<Decrement>>; lappend result $secs

    set result
} -result [list 07 08 09 10 11 10 09 08 07] -cleanup {
    destroy .sb
    unset secs
}

test spinbox-dieoctaldie-2 "Cope with general bad input" -body {
    set result [list]
    ttk::spinbox .sb -from 0 -to 100 -format %03.0f
    .sb set asdfasdf ; lappend result [.sb get]
    event generate .sb <<Increment>> ; lappend result [.sb get]
    .sb set asdfasdf ; lappend result [.sb get]
    event generate .sb <<Decrement>> ; lappend result [.sb get]
} -result [list asdfasdf 000 asdfasdf 000] -cleanup {
    destroy .sb
}

tcltest::cleanupTests

# Local variables:
# mode: tcl
# End: