* tests/unixFont.test (unixFont-2.[234]): fixed to be more

	sensitive on systems that have more installed fonts.

1 files changed, 24 insertions, 5 deletions

diff --git a/tests/unixFont.test b/tests/unixFont.test
index 687faed..00864b8 100644
--- a/tests/unixFont.test
+++ b/tests/unixFont.test
@@ -12,18 +12,37 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: unixFont.test,v 1.4 1999/12/14 06:53:15 hobbs Exp $
+# RCS: @(#) $Id: unixFont.test,v 1.4.2.1 2001/08/28 00:13:31 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
-if {$tcl_platform(platform)!="unix"} {
+if {$tcl_platform(platform) != "unix"} {
     puts "skipping: Unix only tests..."
     ::tcltest::cleanupTests
     return
 }
 
+set ::tcltest::testConfig(hasArial) 1
+set ::tcltest::testConfig(hasCourierNew) 1
+set ::tcltest::testConfig(hasTimesNew) 1
+set xlsf [auto_execok xlsfonts]
+if {$xlsf != ""} {
+    foreach {constraint font} {
+	hasArial	arial
+	hasCourierNew	"courier new"
+	hasTimesNew	"times new roman"
+    } {
+	if {![catch {exec $xlsf *-$font-*} res] \
+		&& ![string match "*unmatched*" $res]} {
+	    # Newer Unix systems have more default fonts installed, so we can't
+	    # rely on fallbacks for fonts to need to fall back on anything.
+	    set ::tcltest::testConfig($constraint) 0
+	}
+    }
+}
+
 catch {destroy .b}
 toplevel .b
 wm geom .b +0+0
@@ -62,21 +81,21 @@ test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
     set x {}
 } {}
 test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} \
-	{noExceed} {
+	{noExceed hasTimesNew} {
     set x {}
     lappend x [lindex [font actual {-family "Times New Roman"}] 1]
     lappend x [lindex [font actual {-family "New York"}] 1]
     lappend x [lindex [font actual {-family "Times"}] 1]
 } {times times times}
 test unixfont-2.3 {TkpGetFontFromAttributes procedure: Courier relatives} \
-	{noExceed} {
+	{noExceed hasCourierNew} {
     set x {}
     lappend x [lindex [font actual {-family "Courier New"}] 1]
     lappend x [lindex [font actual {-family "Monaco"}] 1]
     lappend x [lindex [font actual {-family "Courier"}] 1]
 } {courier courier courier}
 test unixfont-2.4 {TkpGetFontFromAttributes procedure: Helvetica relatives} \
-	{noExceed} {
+	{noExceed hasArial} {
     set x {}
     lappend x [lindex [font actual {-family "Arial"}] 1]
     lappend x [lindex [font actual {-family "Geneva"}] 1]