From 3af8714ddee115926544083d8f1e913be57008ac Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Tue, 4 Nov 2003 23:37:51 +0000 Subject: tk text widget test suite fixes -- bug 833761, making tests much more resilient to font sizes --- ChangeLog | 7 ++++ tests/textDisp.test | 92 ++++++++++++++++++++++++++++++++++--------------- tests/textWind.test | 98 ++++++++++++++++++++++++++++++++++++++++++++++------- 3 files changed, 156 insertions(+), 41 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5e34736..012d87f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2003-11-04 Vince Darley + + * tests/textDisp.test: + * tests/textWind.test: fix to rest of test suite problems + reported in [Bug 833761]. This also has the nice effect + that many more tests are now run on Windows. + 2003-11-04 Donal K. Fellows * library/demos/widget (showCode,printCode): Added code to print diff --git a/tests/textDisp.test b/tests/textDisp.test index 61da0c4..49dbe1b 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textDisp.test,v 1.13 2003/11/03 16:10:12 vincentdarley Exp $ +# RCS: @(#) $Id: textDisp.test,v 1.14 2003/11/04 23:37:51 vincentdarley Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -131,6 +131,36 @@ test textDisp-0.1 {double tag elide transition} { destroy .top } {} +test textDisp-0.2 {double tag elide transition} { + # Example from tkchat crash. For some reason can only + # get this test case to crash when first. + catch {destroy .top} + pack [text .top] + + foreach val {0 1 2 3} { + .top insert 1.0 "hello" + .top tag configure tag$val + .top tag add tag$val 1.0 1.5 + set ::Options(tag$val) 0 + } + + proc DoVis {tag} { + .top tag config $tag -elide $::Options($tag) + } + + proc NickVis {val} { + foreach t [array names ::Options ] { + if {$::Options($t) != $val} { + set ::Options($t) $val + DoVis $t + } + } + } + NickVis 1 + unset ::Options + destroy .top +} {} + test textDisp-1.1 {GetStyle procedure, priorities and tab stops} { .t delete 1.0 end .t insert 1.0 "x\ty" @@ -1470,6 +1500,8 @@ test textDisp-13.7 {TkTextSeeCmd procedure} {textfonts} { .t tag add sel 30.40 update .t see 30.50 + .t yview 25.0 + .t see 30.50 set x [list [.t bbox 30.50]] .t see 30.39 lappend x [.t bbox 30.39] @@ -1477,7 +1509,7 @@ test textDisp-13.7 {TkTextSeeCmd procedure} {textfonts} { lappend x [.t bbox 30.38] .t see 30.20 lappend x [.t bbox 30.20] -} [list [list 73 [expr {9*$fixedDiff + 55}] 7 $fixedHeight] [list 3 [expr {9*$fixedDiff + 55}] 7 $fixedHeight] [list 3 [expr {9*$fixedDiff + 55}] 7 $fixedHeight] [list 73 [expr {9*$fixedDiff + 55}] 7 $fixedHeight]] +} [list [list 73 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 3 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 3 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 73 [expr {5*$fixedDiff + 68}] 7 $fixedHeight]] test textDisp-13.8 {TkTextSeeCmd procedure} {textfonts} { .t xview moveto 0 .t yview moveto 0 @@ -1492,7 +1524,7 @@ test textDisp-13.8 {TkTextSeeCmd procedure} {textfonts} { lappend x [.t bbox 30.65] .t see 30.90 lappend x [.t bbox 30.90] -} [list [list 73 [expr {9*$fixedDiff + 55}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff + 55}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff + 55}] 7 $fixedHeight] [list 73 [expr {9*$fixedDiff + 55}] 7 $fixedHeight]] +} [list [list 73 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 73 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight]] test textDisp-13.9 {TkTextSeeCmd procedure} {textfonts} { wm geom . [expr $width-2]x$height .t xview moveto 0 @@ -1508,7 +1540,7 @@ test textDisp-13.9 {TkTextSeeCmd procedure} {textfonts} { lappend x [.t bbox 30.65] .t see 30.90 lappend x [.t bbox 30.90] -} [list [list 80 [expr {10*$fixedDiff + 55}] 7 $fixedHeight] [list 136 [expr {10*$fixedDiff + 55}] 7 $fixedHeight] [list 136 [expr {10*$fixedDiff + 55}] 7 $fixedHeight] [list 80 [expr {10*$fixedDiff + 55}] 7 $fixedHeight]] +} [list [list 80 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 80 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight]] test textDisp-13.10 {TkTextSeeCmd procedure} {} { # SF Bug 641778 set w .tsee @@ -1746,10 +1778,12 @@ test textDisp-16.15 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto .752 .t index @0,0 } {151.60} -test textDisp-16.16 {TkTextYviewCmd procedure, "moveto" option} { - .t yview moveto .754 +test textDisp-16.16 {TkTextYviewCmd procedure, "moveto" option} {textfonts} { + set count [expr {5 * $bigHeight + 150 * $fixedHeight}] + set extra [expr {0.04 * double($fixedDiff * 150) / double($count)}] + .t yview moveto [expr {.754 - $extra}] .t index @0,0 -} {151.80} +} {151.60} test textDisp-16.17 {TkTextYviewCmd procedure, "moveto" option} { .t yview moveto .755 .t index @0,0 @@ -1828,8 +1862,12 @@ test textDisp-16.28 {TkTextYviewCmd procedure, "scroll" option, forward pages} { .t yview 98.0 update .t yview scroll 1 page - .t index @0,0 -} {103.0} + set res [expr int([.t index @0,0])] + if {$fixedDiff > 1} { + incr res -1 + } + set res +} {102} test textDisp-16.29 {TkTextYviewCmd procedure, "scroll" option, forward pages} { .t configure -height 1 update @@ -1951,9 +1989,9 @@ test textDisp-17.7 {TkTextScanCmd procedure} {textfonts} { .t scan dragto -5 65 .t index @0,0 set x [.t index @0,0] - .t scan dragto 0 70 + .t scan dragto 0 [expr {70 + $fixedDiff}] list $x [.t index @0,0] -} {6.13 3.6} +} {6.13 2.6} test textDisp-17.8 {TkTextScanCmd procedure} {textfonts} { .t yview 1.0 .t xview moveto 0 @@ -1977,10 +2015,9 @@ test textDisp-17.10 {TkTextScanCmd procedure, word wrapping} {textfonts} { .t scan mark -10 60 .t scan dragto -5 65 set x [.t index @0,0] - .t scan dragto 0 70 + .t scan dragto 0 [expr {70 + $fixedDiff}] list $x [.t index @0,0] -} {9.15 8.47} - +} {9.15 8.31} .t configure -xscrollcommand scroll -yscrollcommand {} test textDisp-18.1 {GetXView procedure} { .t configure -wrap none @@ -2355,7 +2392,7 @@ test textDisp-19.12 {GetYView procedure, partially visible last line} { catch {destroy .top} toplevel .top wm geometry .top +0+0 - text .top.t -width 40 -height 5 + text .top.t -width 40 -height 5 -font $fixedFont pack .top.t -expand yes -fill both .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4\nLine 5" # Need to wait for asychronous calculations to complete. @@ -2364,12 +2401,12 @@ test textDisp-19.12 {GetYView procedure, partially visible last line} { wm geom .top ${twidth}x[expr $theight - 3] update .top.t yview -} {0.0 0.9625} +} [list 0.0 [expr {(5.0 * $fixedHeight - 3.0)/ (5.0 * $fixedHeight)}]] test textDisp-19.13 {GetYView procedure, partially visible last line} {textfonts} { catch {destroy .top} toplevel .top wm geometry .top +0+0 - text .top.t -width 40 -height 5 + text .top.t -width 40 -height 5 -font $fixedFont pack .top.t -expand yes -fill both .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4 has enough text to wrap around at least once" # Need to wait for asychronous calculations to complete. @@ -2378,7 +2415,7 @@ test textDisp-19.13 {GetYView procedure, partially visible last line} {textfonts wm geom .top ${twidth}x[expr $theight - 3] update .top.t yview -} {0.0 0.9625} +} [list 0.0 [expr {(5.0 * $fixedHeight - 3.0)/ (5.0 * $fixedHeight)}]] catch {destroy .top} test textDisp-19.14 {GetYView procedure} { .t configure -wrap word @@ -2446,8 +2483,7 @@ test textDisp-19.16 {count -ypixels} { [.t count -ypixels 15.0 "16.0 displaylineend +1c"] \ [.t count -ypixels 16.0 "16.0 displaylineend +1c"] \ [.t count -ypixels "16.0 +1 displaylines" "16.0 +4 displaylines +3c"] -} {300 300 15 30 15 45} - +} [list [expr {260 + 20 * $fixedDiff}] [expr {260 + 20 * $fixedDiff}] $fixedHeight [expr {2*$fixedHeight}] $fixedHeight [expr {3*$fixedHeight}]] .t delete 1.0 end .t insert end "Line 1" for {set i 2} {$i <= 200} {incr i} { @@ -2461,11 +2497,11 @@ test textDisp-20.1 {FindDLine} {textfonts} { list [.t dlineinfo 46.0] [.t dlineinfo 47.0] [.t dlineinfo 49.0] \ [.t dlineinfo 58.0] } [list {} {} [list 3 [expr {$fixedDiff + 16}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] -test textDisp-20.2 {FindDLine} {unixOnly textfonts} { +test textDisp-20.2 {FindDLine} {textfonts} { .t yview 100.0 .t yview -pickplace 53.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.14] [.t dlineinfo 50.15] -} [list {} {} [list 3 3 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] +} [list [list 3 [expr {-1 - $fixedDiff/2}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {-1 - $fixedDiff/2}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {12 + $fixedDiff/2}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] test textDisp-20.3 {FindDLine} {textfonts} { .t yview 100.0 .t yview 49.0 @@ -3191,7 +3227,7 @@ test textDisp-31.1 {line embedded window height update} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list 190 190 105] +} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 6}] [expr {$fixedHeight * 7}]] test textDisp-31.2 {line update index shifting} { set res {} @@ -3208,7 +3244,7 @@ test textDisp-31.2 {line update index shifting} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list 190 220 135 105 190] +} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-31.3 {line update index shifting} { # Should do exactly the same as the above, as long @@ -3232,7 +3268,7 @@ test textDisp-31.3 {line update index shifting} { update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] set res -} [list 190 220 135 105 190] +} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-31.4 {line embedded image height update} { set res {} @@ -3245,7 +3281,7 @@ test textDisp-31.4 {line embedded image height update} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list 190 190 105] +} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 6}] [expr {$fixedHeight * 7}]] test textDisp-31.5 {line update index shifting} { set res {} @@ -3262,7 +3298,7 @@ test textDisp-31.5 {line update index shifting} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list 190 220 135 105 190] +} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-31.6 {line update index shifting} { # Should do exactly the same as the above, as long @@ -3286,7 +3322,7 @@ test textDisp-31.6 {line update index shifting} { update ; after 1000 ; update lappend res [.t count -ypixels 1.0 end] set res -} [list 190 220 135 105 190] +} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] test textDisp-32.0 {everything elided} { # Must not crash diff --git a/tests/textWind.test b/tests/textWind.test index 8cc56db..24499ed 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textWind.test,v 1.10 2003/10/31 18:05:49 vincentdarley Exp $ +# RCS: @(#) $Id: textWind.test,v 1.11 2003/11/04 23:37:51 vincentdarley Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -15,6 +15,16 @@ tcltest::loadTestedCommands # Create entries in the option database to be sure that geometry options # like border width have predictable values. +if {[tcltest::testConstraint fonts]} { + tcltest::testConstraint textfonts 1 +} else { + if {$::tcl_platform(platform) eq "windows"} { + tcltest::testConstraint textfonts 1 + } else { + tcltest::testConstraint textfonts 0 + } +} + option add *Text.borderWidth 2 option add *Text.highlightThickness 2 if {$tcl_platform(platform) == "windows"} { @@ -23,6 +33,19 @@ if {$tcl_platform(platform) == "windows"} { option add *Text.font {Courier -12} } +set fixedFont {Courier -12} +# 15 on XP, 13 on Solaris 8 +set fixedHeight [font metrics $fixedFont -linespace] +# 7 on all platforms +set fixedWidth [font measure $fixedFont m] +# 12 on XP +set fixedAscent [font metrics $fixedFont -ascent] +set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP + +catch {destroy .f} +catch {destroy .t} +catch {destroy .t2} + text .t -width 30 -height 6 -bd 2 -highlightthickness 2 pack append . .t {top expand fill} update @@ -429,7 +452,13 @@ test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} {fonts update list $msg [.t bbox 1.5] } {{{bad window path name "gorp"}} {40 11 0 0}} -test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {fonts} { +proc bgerror args { + global msg + if {[lsearch -exact $msg $args] == -1} { + lappend msg $args + } +} +test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { .t delete 1.0 end .t insert 1.0 "Some sample text" catch {destroy .t.f} @@ -437,22 +466,47 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {fonts frame .t.f frame .t.f.f -width 10 -height 20 -bg $color } - set msg xyzzy + set msg {} update - list $msg [.t bbox 1.5] [winfo exists .t.f.f] -} {{{can't embed .t.f.f relative to .t}} {40 11 0 0} 1} + .t bbox 1.5 ; update ; after 100 + lappend msg [.t bbox 1.5] [winfo exists .t.f.f] +} [list {{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0] 1] +test textWind-10.4.1 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { + .t delete 1.0 end + .t insert 1.0 "Some sample text" + catch {destroy .t.f} + .t window create 1.5 -create { + frame .t.f + frame .t.f.f -width 10 -height 20 -bg $color + } + set msg {} + update idletasks + lappend msg [winfo exists .t.f.f] +} [list {{can't embed .t.f.f relative to .t}} 1] +test textWind-10.4.2 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { + .t delete 1.0 end + .t insert 1.0 "Some sample text" + catch {destroy .t.f} + .t window create 1.5 -create { + frame .t.f + frame .t.f.f -width 10 -height 20 -bg $color + } + set msg {} + update + lappend msg [winfo exists .t.f.f] +} {{{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} 1} catch {destroy .t.f} -test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} {fonts} { +test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { .t delete 1.0 end .t insert 1.0 "Some sample text" .t window create 1.5 -create { concat .t } - set msg xyzzy + set msg {} update - list $msg [.t bbox 1.5] -} {{{can't embed .t relative to .t}} {40 11 0 0}} -test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} {fonts} { + lappend msg [.t bbox 1.5] +} [list {{can't embed .t relative to .t}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] +test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { .t delete 1.0 end .t insert 1.0 "Some sample text" catch {destroy .t2} @@ -461,10 +515,28 @@ test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} {fonts wm geom .t2 +0+0 concat .t2 } - set msg xyzzy + set msg {} update - list $msg [.t bbox 1.5] -} {{{can't embed .t2 relative to .t}} {40 11 0 0}} + lappend msg [.t bbox 1.5] +} [list {{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] +test textWind-10.6.1 {EmbWinLayoutProc procedure, error in creating window} { + .t delete 1.0 end + .t insert 1.0 "Some sample text" + catch {destroy .t2} + .t window create 1.5 -create { + toplevel .t2 -width 100 -height 150 + wm geom .t2 +0+0 + concat .t2 + } + set msg {} + update + set msg +} {{{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}}} + +proc bgerror args { + global msg + set msg $args +} test textWind-10.7 {EmbWinLayoutProc procedure, steal window from self} { .t delete 1.0 end .t insert 1.0 ABCDEFGHIJKLMNOP -- cgit v0.12