Import Tk 8.6.6 (as of svn r86089)
This commit is contained in:
69
tests/ttk/scrollbar.test
Normal file
69
tests/ttk/scrollbar.test
Normal file
@@ -0,0 +1,69 @@
|
||||
package require Tk 8.5
|
||||
package require tcltest ; namespace import -force tcltest::*
|
||||
loadTestedCommands
|
||||
|
||||
testConstraint coreScrollbar [expr {[tk windowingsystem] eq "aqua"}]
|
||||
|
||||
test scrollbar-swapout-1 "Use core scrollbars on OSX..." -constraints {
|
||||
coreScrollbar
|
||||
} -body {
|
||||
ttk::scrollbar .sb -command "yadda"
|
||||
list [winfo class .sb] [.sb cget -command]
|
||||
} -result [list Scrollbar yadda] -cleanup {
|
||||
destroy .sb
|
||||
}
|
||||
|
||||
test scrollbar-swapout-2 "... unless -style is specified ..." -constraints {
|
||||
coreScrollbar
|
||||
} -body {
|
||||
ttk::style layout Vertical.Custom.TScrollbar \
|
||||
[ttk::style layout Vertical.TScrollbar] ; # See #1833339
|
||||
ttk::scrollbar .sb -command "yadda" -style Custom.TScrollbar
|
||||
list [winfo class .sb] [.sb cget -command] [.sb cget -style]
|
||||
} -result [list TScrollbar yadda Custom.TScrollbar] -cleanup {
|
||||
destroy .sb
|
||||
}
|
||||
|
||||
test scrollbar-swapout-3 "... or -class." -constraints {
|
||||
coreScrollbar
|
||||
} -body {
|
||||
ttk::scrollbar .sb -command "yadda" -class Custom.TScrollbar
|
||||
list [winfo class .sb] [.sb cget -command]
|
||||
} -result [list Custom.TScrollbar yadda] -cleanup {
|
||||
destroy .sb
|
||||
}
|
||||
|
||||
test scrollbar-1.0 "Setup" -body {
|
||||
ttk::scrollbar .tsb
|
||||
} -result .tsb
|
||||
|
||||
test scrollbar-1.1 "Set method" -body {
|
||||
.tsb set 0.2 0.4
|
||||
.tsb get
|
||||
} -result [list 0.2 0.4]
|
||||
|
||||
test scrollbar-1.2 "Set orientation" -body {
|
||||
.tsb configure -orient vertical
|
||||
set w [winfo reqwidth .tsb] ; set h [winfo reqheight .tsb]
|
||||
expr {$h > $w}
|
||||
} -result 1
|
||||
|
||||
test scrollbar-1.3 "Change orientation" -body {
|
||||
.tsb configure -orient horizontal
|
||||
set w [winfo reqwidth .tsb] ; set h [winfo reqheight .tsb]
|
||||
expr {$h < $w}
|
||||
} -result 1
|
||||
|
||||
#
|
||||
# Scale tests:
|
||||
#
|
||||
|
||||
test scale-1.0 "Self-destruction" -body {
|
||||
trace variable v w { destroy .s ;# }
|
||||
ttk::scale .s -variable v
|
||||
pack .s ; update
|
||||
.s set 1 ; update
|
||||
} -returnCodes 1 -match glob -result "*"
|
||||
|
||||
tcltest::cleanupTests
|
||||
|
||||
Reference in New Issue
Block a user