summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog7
-rw-r--r--tests/textDisp.test92
-rw-r--r--tests/textWind.test98
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 <vincentdarley@users.sourceforge.net>
+
+ * 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 <donal.k.fellows@man.ac.uk>
* 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
generated by cgit v0.12 at 2024-11-18 10:00:47 (GMT)