textTag.test: Replace constraint failsOnUbuntuNoXft by a more specific constraint bigFontTwiceLargerThanTextFont checking exactly what is needed. Note: Without the constraint three tests (-16.2, -16.6 and -16.7) fail when run at Github Actions CI with XQuartz because the font actually selected when requesting bigFont as {Helvetica 24} is 'times 9', which has actual size of 9, for an unknown reason.

1 files changed, 17 insertions, 8 deletions

diff --git a/tests/textTag.test b/tests/textTag.test
index a921cb3..1930062 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -11,18 +11,27 @@ namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}]
-testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}]
+set fixedFont     {Courier 12}
+set fixedFontBold {Courier 12 bold}
+set bigFont       {Helvetica 24}
+# Although unexpected, this constraint happens to evaluate to false on at least one system: the Github CI runner on Linux with --disable-xft
+testConstraint bigFontTwiceLargerThanTextFont [expr {[font actual $fixedFont -size] * 2 <= [font actual $bigFont -size]}]
+
+# Warn the user if the actual font is too different from what was requested.
+if {[font metrics [font actual $fixedFont] -fixed] != 1} {
+    puts "---> Warning: the font actually used by the tests, which is \"[font actual $fixedFont]\",\
+does not seem to be a fixed-width font as expected. If this is really the case, many upcoming\
+tests will fail."
+}
 
 destroy .t
-text .t -width 20 -height 10 -font {Courier 12}
+text .t -width 20 -height 10 -font $fixedFont
 
 pack .t -expand 1 -fill both
 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.
@@ -381,7 +390,7 @@ test textTag-2.14 {tag add before -startline - Bug 1615425} -body {
     for {set i 1} {$i <10} {incr i} {
         .tt insert end "Line $i\n"
     }
-    .tt tag configure mytag -font {Courier 12 bold}
+    .tt tag configure mytag -font $fixedFontBold
     .tt peer create .ptt
     .ptt configure -startline 3 -endline 7
     # the test succeeds if next line does not crash
@@ -1343,7 +1352,7 @@ test textTag-16.1 {TkTextPickCurrent procedure} -setup {
 } -result {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
 
 test textTag-16.2 {TkTextPickCurrent procedure} -constraints {
-    failsOnUbuntuNoXft
+    bigFontTwiceLargerThanTextFont
 } -setup {
     .t tag delete {*}[.t tag names]
     wm geometry . +200+200 ; update
@@ -1439,7 +1448,7 @@ test textTag-16.5 {TkTextPickCurrent procedure} -setup {
 } -result {3.2}
 
 test textTag-16.6 {TkTextPickCurrent procedure} -constraints {
-    failsOnUbuntuNoXft
+    bigFontTwiceLargerThanTextFont
 } -setup {
     foreach i {big a b c d} {
         .t tag remove $i 1.0 end
@@ -1460,7 +1469,7 @@ test textTag-16.6 {TkTextPickCurrent procedure} -constraints {
 } -result {3.1}
 
 test textTag-16.7 {TkTextPickCurrent procedure} -constraints {
-    failsOnUbuntuNoXft
+    bigFontTwiceLargerThanTextFont
 } -setup {
     foreach i {big a b c d} {
         .t tag remove $i 1.0 end