diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/ttk/notebook.test | 56 | ||||
| -rw-r--r-- | tests/ttk/panedwindow.test | 50 |
2 files changed, 96 insertions, 10 deletions
diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test index b07ed30..8f97464 100644 --- a/tests/ttk/notebook.test +++ b/tests/ttk/notebook.test @@ -1,5 +1,5 @@ # -# $Id: notebook.test,v 1.3 2007/10/25 22:52:42 jenglish Exp $ +# $Id: notebook.test,v 1.4 2007/11/25 18:11:13 jenglish Exp $ # package require Tk 8.5 @@ -158,9 +158,10 @@ test notebook-6.1 "Hide selected tab" -setup { } -body { set result [list] lappend result [$nb index current] [winfo ismapped $nb.f2] - $nb tab $nb.f2 -state hidden + $nb hide $nb.f2 lappend result [$nb index current] [winfo ismapped $nb.f2] -} -result [list 1 1 2 0] + update idletasks; lappend result [winfo ismapped $nb.f3] +} -result [list 1 1 2 0 1] # See 1370833 test notebook-6.2 "Forget selected tab" -setup { @@ -188,7 +189,7 @@ test notebook-6.3 "Hide first tab when it's the current" -setup { } -body { set result [list] lappend result [$nb index current] [winfo ismapped $nb.f1] - $nb tab $nb.f1 -state hidden + $nb hide $nb.f1 lappend result [$nb index current] [winfo ismapped $nb.f1] } -result [list 0 1 1 0] @@ -218,7 +219,7 @@ test notebook-6.5 "Hide last tab when it's the current" -setup { } -body { set result [list] lappend result [$nb index current] [winfo ismapped $nb.f3] - $nb tab $nb.f3 -state hidden + $nb hide $nb.f3 lappend result [$nb index current] [winfo ismapped $nb.f3] } -result [list 2 1 1 0] @@ -248,7 +249,7 @@ test notebook-6.7 "Hide a middle tab when it's the current" -setup { } -body { set result [list] lappend result [$nb index current] [winfo ismapped $nb.f2] - $nb tab $nb.f2 -state hidden + $nb hide $nb.f2 lappend result [$nb index current] [winfo ismapped $nb.f2] } -result [list 1 1 2 0] @@ -278,7 +279,7 @@ test notebook-6.9 "Hide a non-current tab < current" -setup { } -body { set result [list] lappend result [$nb index current] [winfo ismapped $nb.f2] - $nb tab $nb.f1 -state hidden + $nb hide $nb.f1 lappend result [$nb index current] [winfo ismapped $nb.f2] } -result [list 1 1 1 1] @@ -308,10 +309,27 @@ test notebook-6.11 "Hide a non-current tab > current" -setup { } -body { set result [list] lappend result [$nb index current] [winfo ismapped $nb.f2] - $nb tab $nb.f3 -state hidden + $nb hide $nb.f3 lappend result [$nb index current] [winfo ismapped $nb.f2] } -result [list 1 1 1 1] +test notebook-6.12 "Hide and re-add a tab" -setup { + pack [set nb [ttk::notebook .nb]]; update + $nb add [ttk::frame $nb.f1] + $nb add [ttk::frame $nb.f2] + $nb add [ttk::frame $nb.f3] + $nb select $nb.f2 +} -cleanup { + destroy $nb +} -body { + set result [list] + lappend result [$nb index current] [$nb tab $nb.f2 -state] + $nb hide $nb.f2 + lappend result [$nb index current] [$nb tab $nb.f2 -state] + $nb add $nb.f2 + lappend result [$nb index current] [$nb tab $nb.f2 -state] +} -result [list 1 normal 2 hidden 2 normal] + # # Insert: # @@ -454,4 +472,26 @@ test notebook-1817596-3 "insert/configure" -body { } -result [list [list .nb.l2 .nb.l0 .nb.l1] L2 L0 L1] -cleanup { destroy .nb } + +# See #1343984 +test notebook-1343984-1 "don't autoselect on destroy - setup" -body { + ttk::notebook .nb + set ::history [list] + bind TestFrame <Map> { lappend history MAP %W } + bind TestFrame <Destroy> { lappend history DESTROY %W } + .nb add [ttk::frame .nb.frame1 -class TestFrame] -text "Frame 1" + .nb add [ttk::frame .nb.frame2 -class TestFrame] -text "Frame 2" + .nb add [ttk::frame .nb.frame3 -class TestFrame] -text "Frame 3" + pack .nb -fill both -expand 1 + update + set ::history +} -result [list MAP .nb.frame1] + +test notebook-1343984-2 "don't autoselect on destroy" -body { + set ::history [list] + destroy .nb + update + set ::history +} -result [list DESTROY .nb.frame1 DESTROY .nb.frame2 DESTROY .nb.frame3] + tcltest::cleanupTests diff --git a/tests/ttk/panedwindow.test b/tests/ttk/panedwindow.test index 81232ba..e9aa921 100644 --- a/tests/ttk/panedwindow.test +++ b/tests/ttk/panedwindow.test @@ -1,11 +1,12 @@ # -# $Id: panedwindow.test,v 1.4 2007/06/10 03:25:32 jenglish Exp $ +# $Id: panedwindow.test,v 1.5 2007/11/25 18:11:13 jenglish Exp $ # package require Tk 8.5 package require tcltest ; namespace import -force tcltest::* loadTestedCommands +proc propagate-geometry {} { update idletasks } # Basic sanity checks: # @@ -220,7 +221,7 @@ test paned-sashpos-setup "Setup for sash position test" -body { .pw add [frame .pw.f3 -width 20 -height 20] .pw add [frame .pw.f4 -width 20 -height 20] - update idletasks + propagate-geometry list [winfo reqwidth .pw] [winfo reqheight .pw] } -result [list 20 [expr {20*4 + 5*3}]] @@ -246,4 +247,49 @@ test paned-sashpos-restore "Set height then sash positions" -body { test paned-sashpos-cleanup "Clean up" -body { destroy .pw } +test paned-propagation-setup "Setup." -body { + ttk::style theme use default + ttk::style configure -sashthickness 5 + wm geometry . {} + ttk::panedwindow .pw -orient vertical + + frame .pw.f1 -width 100 -height 50 + frame .pw.f2 -width 100 -height 50 + + list [winfo reqwidth .pw.f1] [winfo reqheight .pw.f1] +} -result [list 100 50] + +test paned-propagation-1 "Initial request size" -body { + .pw add .pw.f1 + .pw add .pw.f2 + propagate-geometry + list [winfo reqwidth .pw] [winfo reqheight .pw] +} -result [list 100 105] + +test paned-propagation-2 "Slave change before map" -body { + .pw.f1 configure -width 200 -height 100 + propagate-geometry + list [winfo reqwidth .pw] [winfo reqheight .pw] +} -result [list 200 155] + +test paned-propagation-3 "Map window" -body { + pack .pw -expand true -fill both + update + list [winfo width .pw] [winfo height .pw] [.pw sashpos 0] +} -result [list 200 155 100] + +test paned-propagation-4 "Slave change after map, off-axis" -body { + .pw.f1 configure -width 100 ;# should be granted + propagate-geometry + list [winfo reqwidth .pw] [winfo reqheight .pw] [.pw sashpos 0] +} -result [list 100 155 100] + +test paned-propagation-5 "Slave change after map, on-axis" -body { + .pw.f1 configure -height 50 ;# should be denied + propagate-geometry + list [winfo reqwidth .pw] [winfo reqheight .pw] [.pw sashpos 0] +} -result [list 100 155 100] + +test paned-propagation-cleanup "Clean up." -body { destroy .pw } + tcltest::cleanupTests |