summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/unixFont.test29
1 files changed, 24 insertions, 5 deletions
diff --git a/tests/unixFont.test b/tests/unixFont.test
index 687faed..34f0040 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.5 2001/08/22 01:25:53 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]