diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/text.test | 188 | ||||
| -rw-r--r-- | tests/textDisp.test | 41 |
2 files changed, 201 insertions, 28 deletions
diff --git a/tests/text.test b/tests/text.test index 7c1731d..2487df7 100644 --- a/tests/text.test +++ b/tests/text.test @@ -153,7 +153,7 @@ test text-3.1 {TextWidgetCmd procedure, basics} { } {1 {wrong # args: should be ".t option ?arg arg ...?"}} test text-3.2 {TextWidgetCmd procedure} { list [catch {.t gorp 1.0 z 1.2} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} +} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} test text-4.1 {TextWidgetCmd procedure, "bbox" option} { list [catch {.t bbox} msg] $msg @@ -221,7 +221,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} { } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} test text-6.14 {TextWidgetCmd procedure, "compare" option} { list [catch {.t co 1.0 z 1.2} msg] $msg -} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} +} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} # "configure" option is already covered above @@ -230,7 +230,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} { } {1 {wrong # args: should be ".t debug boolean"}} test text-7.2 {TextWidgetCmd procedure, "debug" option} { list [catch {.t de 0 1} msg] $msg -} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} +} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb @@ -745,10 +745,7 @@ test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { .t tag configure hidden -elide true .t tag add hidden 5.7 11.0 update - # next line to be fully sure that asynchronous line heights calculation is - # up-to-date otherwise this test may fail (depending on the computer - # performance), especially when the . toplevel has small height - .t count -update -ypixels 1.0 end + .t sync set y1 [lindex [.t yview] 1] .t count -displaylines 5.0 11.0 set y2 [lindex [.t yview] 1] @@ -901,7 +898,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} { } {1 {wrong # args: should be ".t index index"}} test text-10.3 {TextWidgetCmd procedure, "index" option} { list [catch {.t in a b} msg] $msg -} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} +} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingsync, replace, scan, search, see, sync, tag, window, xview, or yview}} test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} @@ -960,7 +957,178 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} { list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly] } {{First second} {1.0 1.5} {1.5 1.12}} -# Edit, mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere. +test text-11a.1 {TextWidgetCmd procedure, "pendingsync" option} -setup { + destroy .yt +} -body { + text .yt + list [catch {.yt pendingsync mytext} msg] $msg +} -cleanup { + destroy .yt +} -result {1 {wrong # args: should be ".yt pendingsync"}} +test text-11a.2 {TextWidgetCmd procedure, "pendingsync" option} -setup { + destroy .top.yt .top +} -body { + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + while {[.top.yt pendingsync]} {update} + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + # ensure the test is relevant + lappend res [.top.yt pendingsync] + # asynchronously wait for completion of line metrics calculation + while {[.top.yt pendingsync]} {update} + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} -cleanup { + destroy .top.yt .top +} -result {1 1 1} + +test text-11a.11 {TextWidgetCmd procedure, "sync" option} -setup { + destroy .yt +} -body { + text .yt + list [catch {.yt sync mytext} msg] $msg +} -cleanup { + destroy .yt +} -result {1 {wrong # args: should be ".yt sync ?-command command?"}} +test text-11a.12 {TextWidgetCmd procedure, "sync" option} -setup { + destroy .top.yt .top +} -body { + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 30} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + .top.yt sync + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + # first case: do not wait for completion of line metrics calculation + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] + # second case: wait for completion of line metrics calculation + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + .top.yt sync + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} -cleanup { + destroy .top.yt .top +} -result {1 0 1} + +test text-11a.21 {TextWidgetCmd procedure, "sync" option with -command} -setup { + destroy .yt +} -body { + text .yt + list [catch {.yt sync -comx foo} msg] $msg +} -cleanup { + destroy .yt +} -result {1 {wrong option "-comx": should be "-command"}} +test text-11a.22 {TextWidgetCmd procedure, "sync" option with -command} -setup { + destroy .top.yt .top +} -body { + set res {} + set ::x 0 + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 30} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # first case: line metrics calculation still running when launching 'sync -command' + lappend res [.top.yt pendingsync] + .top.yt sync -command [list set ::x 1] + lappend res $::x + # now finish line metrics calculations + while {[.top.yt pendingsync]} {update} + lappend res [.top.yt pendingsync] $::x + # second case: line metrics calculation completed when launching 'sync -command' + .top.yt sync -command [list set ::x 2] + lappend res $::x + vwait ::x + lappend res $::x +} -cleanup { + destroy .top.yt .top +} -result {1 0 0 1 1 2} + +test text-11a.31 {"<<WidgetViewSync>>" event} -setup { + destroy .top.yt .top +} -body { + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + update + bind .top.yt <<WidgetViewSync>> { if {%d} {set yud(%W) 1} } + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + if {[.top.yt pendingsync]} {vwait yud(.top.yt)} + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + # synchronously wait for completion of line metrics calculation + # and ensure the test is relevant + set waited 0 + if {[.top.yt pendingsync]} {set waited 1 ; vwait yud(.top.yt)} + lappend res $waited + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} -cleanup { + destroy .top.yt .top +} -result {1 1 1} + +test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup { + destroy .top.yt .top +} -body { + set res {} + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 300} {incr i} { + append content [string repeat "$i " 50] \n + } + bind .top.yt <<WidgetViewSync>> {lappend res Sync:%d} + .top.yt insert 1.0 $content + vwait res ; # event dealt with by the event loop, with %d==0 i.e. we're out of sync + # ensure the test is relevant + lappend res "Pending:[.top.yt pendingsync]" + # - <<WidgetViewSync>> fires when sync returns if there was pending syncs + # - there is no more any pending sync after running 'sync' + .top.yt sync + vwait res ; # event dealt with by the event loop, with %d==1 i.e. we're in sync again + lappend res "Pending:[.top.yt pendingsync]" + set res +} -cleanup { + destroy .top.yt .top +} -result {Sync:0 Pending:1 Sync:1 Pending:0} + +# edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere. test text-12.1 {ConfigureText procedure} { list [catch {.t2 configure -state foobar} msg] $msg @@ -3698,7 +3866,7 @@ test text-31.2 {TextWidgetCmd procedure, "peer" option} { list [catch {.t peer names foo} msg] $msg } {1 {wrong # args: should be ".t peer names"}} test text-31.3 {TextWidgetCmd procedure, "peer" option} { - list [catch {.t p names} msg] $msg + list [catch {.t pee names} msg] $msg } {0 {}} test text-31.4 {TextWidgetCmd procedure, "peer" option} { .t peer names diff --git a/tests/textDisp.test b/tests/textDisp.test index ac3aee0..caba769 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -4197,29 +4197,34 @@ test textDisp-33.5 {bold or italic fonts} win { } {italic font measurement ok} destroy .tt -test textDisp-34.1 {Text widgets multi-scrolling problem: Bug 2677890} -setup { - pack [text .t1 -width 10 -yscrollcommand {.sy set}] \ - [ttk::scrollbar .sy -orient vertical -command {.t1 yview}] \ - -side left -fill both - bindtags .sy {}; # No clicky! +test textDisp-34.1 {Line heights recalculation problem: bug 2677890} -setup { + pack [text .t1] -expand 1 -fill both set txt "" - for {set i 0} {$i < 99} {incr i} { - lappend txt "$i" [list pc $i] "\n" "" + for {set i 1} {$i < 100} {incr i} { + append txt "Line $i\n" } set result {} } -body { - .t1 insert end {*}$txt - update - lappend result [.sy get] - .t1 replace 6.0 6.0+1c "*" - lappend result [.sy get] - after 0 {lappend result [.sy get]} - after 1000 {lappend result [.sy get]} - vwait result;vwait result - return $result + .t1 insert end $txt + .t1 debug 1 + set ge [winfo geometry .] + scan $ge "%dx%d+%d+%d" width height left top + update + .t1 sync + set negative 0 + bind .t1 <<WidgetViewSync>> { if {%d < 0} {set negative 1} } + # Without the fix for bug 2677890, changing the width of the toplevel + # will launch recomputation of the line heights, but will produce negative + # number of still remaining outdated lines, which is obviously wrong. + # Thus we use this way to check for regression regarding bug 2677890, + # i.e. to check that the fix for this bug really is still in. + wm geometry . "[expr {$width * 2}]x$height+$left+$top" + update + .t1 sync + set negative } -cleanup { - destroy .t1 .sy -} -result {{0.0 0.24} {0.0 0.24} {0.0 0.24} {0.0 0.24}} + destroy .t1 +} -result {0} test textDisp-35.1 {Init value of charHeight - Dancing scrollbar bug 1499165} -setup { pack [text .t1] -fill both -expand y -side left |