Fixed [3ee76e41c2] - New textTag test failures

1 files changed, 54 insertions, 14 deletions

diff --git a/tests/textTag.test b/tests/textTag.test
index 2df8c5a..93feb27 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -11,6 +11,21 @@ namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
+set textWidgetFont {Courier 12}
+set bigFont        {Courier 24}
+
+# what is needed is a font that is both fixed-width and featuring a
+# specific size because in some tests (that will be constrained by
+# haveFontSizes), a tag applying the $bigFont will be set to some
+# characters, which action has the effect of changing what character
+# is under the mouse pointer, which is the purpose of the tests
+testConstraint haveFontSizes [expr {
+    [font metrics $textWidgetFont -fixed] &&
+    [font actual  $textWidgetFont -size] == 12 &&
+    [font metrics $bigFont -fixed] &&
+    [font actual  $bigFont -size] == 24 }
+]
+
 destroy .t
 text .t -width 20 -height 10
 
@@ -19,7 +34,6 @@ update
 .t debug on
 
 wm geometry . {}
-set bigFont {Helvetica 24}
 
 # The statements below reset the main window;  it's needed if the window
 # manager is mwm, to make mwm forget about a previous minimum size setting.
@@ -1196,7 +1210,8 @@ test textTag-14.4 {SortTags} -setup {
 } -result {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
 
 
-
+set curFont [.t cget -font]
+set curWrap [.t cget -wrap]
 set c [.t bbox 2.1]
 set x1 [expr [lindex $c 0] + [lindex $c 2]/2]
 set y1 [expr [lindex $c 1] + [lindex $c 3]/2]
@@ -1206,6 +1221,15 @@ set y2 [expr [lindex $c 1] + [lindex $c 3]/2]
 set c [.t bbox 4.3]
 set x3 [expr [lindex $c 0] + [lindex $c 2]/2]
 set y3 [expr [lindex $c 1] + [lindex $c 3]/2]
+.t configure -font $textWidgetFont -wrap none
+update
+set c [.t bbox 2.1]
+set x4 [expr [lindex $c 0] + [lindex $c 2]/2]
+set y4 [expr [lindex $c 1] + [lindex $c 3]/2]
+set c [.t bbox 3.2]
+set x5 [expr [lindex $c 0] + [lindex $c 2]/2]
+set y5 [expr [lindex $c 1] + [lindex $c 3]/2]
+.t configure -font $curFont -wrap $curWrap
 
 test textTag-15.1 {TkTextBindProc} -setup {
     .t tag delete x y
@@ -1313,19 +1337,23 @@ test textTag-16.1 {TkTextPickCurrent procedure} -setup {
     lappend x [.t index current]
 } -result {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
 
-test textTag-16.2 {TkTextPickCurrent procedure} -setup {
+test textTag-16.2 {TkTextPickCurrent procedure} -constraints {
+    haveFontSizes
+} -setup {
     .t tag delete {*}[.t tag names]
     event generate {} <Motion> -warp 1 -x -1 -y -1; update
+    .t configure -font $textWidgetFont -wrap none
 } -body {
     .t tag configure big -font $bigFont
-    event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
-    event gen .t <Motion> -x $x2 -y $y2
+    event gen .t <ButtonRelease-1> -state 0x100 -x $x4 -y $y4
+    event gen .t <Motion> -x $x5 -y $y5
     set x [.t index current]
     .t tag add big 3.0
     update
     lappend x [.t index current]
 } -cleanup {
     .t tag delete big
+    .t configure -font $curFont -wrap $curWrap
 } -result {3.2 3.1}
 
 test textTag-16.3 {TkTextPickCurrent procedure} -setup {
@@ -1381,57 +1409,69 @@ test textTag-16.4 {TkTextPickCurrent procedure} -setup {
     .t tag delete {*}[.t tag names]
 } -result {enter-a enter-b enter-c | leave-c leave-b}
 
-test textTag-16.5 {TkTextPickCurrent procedure} -setup {
+test textTag-16.5 {TkTextPickCurrent procedure} -constraints {
+    haveFontSizes
+} -setup {
     foreach i {big a b c d} {
         .t tag remove $i 1.0 end
     }
     event generate {} <Motion> -warp 1 -x -1 -y -1; update
+    .t configure -font $textWidgetFont -wrap none
 } -body {
     .t tag configure big -font $bigFont
-    event gen .t <Motion> -x $x1 -y $y1
+    event gen .t <Motion> -x $x4 -y $y4
     .t tag bind a <Enter> {.t tag add big 3.0 3.2}
     .t tag add a 3.2
-    event gen .t <Motion> -x $x2 -y $y2
+    event gen .t <Motion> -x $x5 -y $y5
     .t index current
 } -cleanup {
     .t tag delete a big
+    .t configure -font $curFont -wrap $curWrap
 } -result {3.2}
 
-test textTag-16.6 {TkTextPickCurrent procedure} -setup {
+test textTag-16.6 {TkTextPickCurrent procedure} -constraints {
+    haveFontSizes
+} -setup {
     foreach i {big a b c d} {
         .t tag remove $i 1.0 end
     }
     event generate {} <Motion> -warp 1 -x -1 -y -1; update
+    .t configure -font $textWidgetFont -wrap none
 } -body {
     .t tag configure big -font $bigFont
-    event gen .t <Motion> -x $x1 -y $y1
+    event gen .t <Motion> -x $x4 -y $y4
     .t tag bind a <Enter> {.t tag add big 3.0 3.2}
     .t tag add a 3.2
-    event gen .t <Motion> -x $x2 -y $y2
+    event gen .t <Motion> -x $x5 -y $y5
     update
     .t index current
 } -cleanup {
     .t tag delete a big
+    .t configure -font $curFont -wrap $curWrap
 } -result {3.1}
 
-test textTag-16.7 {TkTextPickCurrent procedure} -setup {
+test textTag-16.7 {TkTextPickCurrent procedure} -constraints {
+    haveFontSizes
+} -setup {
     foreach i {big a b c d} {
         .t tag remove $i 1.0 end
     }
     event generate {} <Motion> -warp 1 -x -1 -y -1; update
+    .t configure -font $textWidgetFont -wrap none
 } -body {
     .t tag configure big -font $bigFont
     .t tag bind a <Enter> {.t tag add big 3.0 3.2}
     .t tag add a 3.2
 
-    event gen .t <Motion> -x $x1 -y $y1
+    event gen .t <Motion> -x $x4 -y $y4
     .t tag bind a <Leave> {.t tag add big 3.0 3.2}
     .t tag add a 2.1
-    event gen .t <Motion> -x $x2 -y $y2
+    event gen .t <Motion> -x $x5 -y $y5
     update
     .t index current
 } -cleanup {
     .t tag delete a big
+    .t configure -font $curFont -wrap $curWrap
 } -result {3.1}