diff options
Diffstat (limited to 'tests/unixFont.test')
| -rw-r--r-- | tests/unixFont.test | 141 |
1 files changed, 71 insertions, 70 deletions
diff --git a/tests/unixFont.test b/tests/unixFont.test index 34f0040..16d2bf8 100644 --- a/tests/unixFont.test +++ b/tests/unixFont.test @@ -12,33 +12,34 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# 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"} { - puts "skipping: Unix only tests..." - ::tcltest::cleanupTests - return -} - -set ::tcltest::testConfig(hasArial) 1 -set ::tcltest::testConfig(hasCourierNew) 1 -set ::tcltest::testConfig(hasTimesNew) 1 +# RCS: @(#) $Id: unixFont.test,v 1.6 2002/07/12 13:40:59 dgp Exp $ + +package require tcltest 2.1 +namespace import -force tcltest::test +namespace import -force tcltest::testConstraint +namespace import -force tcltest::testsDirectory +namespace import -force tcltest::configure +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands +eval configure $argv + +testConstraint hasArial 1 +testConstraint hasCourierNew 1 +testConstraint hasTimesNew 1 set xlsf [auto_execok xlsfonts] -if {$xlsf != ""} { +if {[llength $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 + if {![catch {eval exec $xlsf [list *-$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. + testConstraint $constraint 0 } } } @@ -69,58 +70,58 @@ proc getsize {} { return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" } -test unixfont-1.1 {TkpGetNativeFont procedure: not native} {noExceed} { +test unixfont-1.1 {TkpGetNativeFont procedure: not native} {unix noExceed} { list [catch {font measure {} xyz} msg] $msg } {1 {font "" doesn't exist}} -test unixfont-1.2 {TkpGetNativeFont procedure: native} { +test unixfont-1.2 {TkpGetNativeFont procedure: native} unix { font measure fixed 0 } {6} -test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} { +test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} unix { font actual {-size 10} set x {} } {} test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} \ - {noExceed hasTimesNew} { + {unix 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 hasCourierNew} { + {unix 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 hasArial} { + {unix noExceed hasArial} { set x {} lappend x [lindex [font actual {-family "Arial"}] 1] lappend x [lindex [font actual {-family "Geneva"}] 1] lappend x [lindex [font actual {-family "Helvetica"}] 1] } {helvetica helvetica helvetica} -test unixfont-2.5 {TkpGetFontFromAttributes procedure: fallback} { +test unixfont-2.5 {TkpGetFontFromAttributes procedure: fallback} unix { font actual {-xyz-xyz-*-*-*-*-*-*-*-*-*-*-*-*} set x {} } {} -test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} { +test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} unix { lindex [font actual {-family fixed -size 10}] 1 } {fixed} -test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} { +test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} unix { # no test available } {} -test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} { +test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} unix { lindex [font actual {-family fixed -size 31}] 1 } {fixed} -test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {noExceed} { +test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {unix noExceed} { lindex [font actual {-family courier}] 1 } {courier} -test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} { +test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} unix { lindex [font actual {-family courier -size 37}] 3 } {37} -test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} { +test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} unix { # On Linux, XListFonts() was returning names for fonts that do not # actually exist, causing the subsequent XLoadQueryFont() to fail # unexpectedly. Now falls back to another font if that happens. @@ -129,114 +130,114 @@ test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} { set x {} } {} -test unixfont-3.1 {TkpDeleteFont procedure} { +test unixfont-3.1 {TkpDeleteFont procedure} unix { font actual {-family xyz} set x {} } {} -test unixfont-4.1 {TkpGetFontFamilies procedure} { +test unixfont-4.1 {TkpGetFontFamilies procedure} unix { font families set x {} } {} -test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} { +test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} unix { .b.l config -text "000000" -wrap [expr $ax*3] .b.l config -wrap 0 } {} -test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} { +test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} unix { .b.l config -text "000000" } {} -test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} { +test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} unix { .b.l config -text "0" .b.l config -text "\377" .b.l config -text "0\3770\377" .b.l config -text "000000000000000" } {} .b.l config -wrap [expr $ax*10] -test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} { +test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} unix { .b.l config -text "0000000000000" getsize } "[expr $ax*10] [expr $ay*2]" -test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} { +test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} unix { .b.l config -text "000000" getsize } "[expr $ax*6] $ay" -test unixfont-5.6 {Tk_MeasureChars procedure: find last word} { +test unixfont-5.6 {Tk_MeasureChars procedure: find last word} unix { .b.l config -text "000000 00000" getsize } "[expr $ax*6] [expr $ay*2]" -test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} { +test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} unix { .b.l config -text "000000 00000" getsize } "[expr $ax*6] [expr $ay*2]" -test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} { +test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} unix { .b.l config -text "00 000 00000" getsize } "[expr $ax*7] [expr $ay*2]" -test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} { +test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0000" .b.c index $t @[expr int($ax*2.5)],1 } {2} -test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} { +test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} unix { .b.l config -text "000000000000" getsize } "[expr $ax*10] [expr $ay*2]" -test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} { +test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} unix { set a [.b.l cget -wrap] .b.l config -text "000000" -wrap 1 set x [getsize] .b.l config -wrap $a set x } "$ax [expr $ay*6]" -test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} { +test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} unix { .b.l config -text "000 \n000" getsize } "[expr $ax*6] [expr $ay*2]" -test unixfont-6.1 {Tk_DrawChars procedure: loop test} { +test unixfont-6.1 {Tk_DrawChars procedure: loop test} unix { .b.l config -text "a" update } {} -test unixfont-6.2 {Tk_DrawChars procedure: loop test} { +test unixfont-6.2 {Tk_DrawChars procedure: loop test} unix { .b.l config -text "abcd" update } {} -test unixfont-6.3 {Tk_DrawChars procedure: special char} { +test unixfont-6.3 {Tk_DrawChars procedure: special char} unix { .b.l config -text "\001" update } {} -test unixfont-6.4 {Tk_DrawChars procedure: normal then special} { +test unixfont-6.4 {Tk_DrawChars procedure: normal then special} unix { .b.l config -text "ab\001" update } {} -test unixfont-6.5 {Tk_DrawChars procedure: ends with special} { +test unixfont-6.5 {Tk_DrawChars procedure: ends with special} unix { .b.l config -text "ab\001" update } {} -test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} { +test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} unix { .b.l config -text "ab\001def" update } {} -test unixfont-7.1 {DrawChars procedure: no effects} { +test unixfont-7.1 {DrawChars procedure: no effects} unix { .b.l config -text "abc" update } {} -test unixfont-7.2 {DrawChars procedure: underlining} { +test unixfont-7.2 {DrawChars procedure: underlining} unix { set f [.b.l cget -font] .b.l config -text "abc" -font "courier 10 underline" update .b.l config -font $f } {} -test unixfont-7.3 {DrawChars procedure: overstrike} { +test unixfont-7.3 {DrawChars procedure: overstrike} unix { set f [.b.l cget -font] .b.l config -text "abc" -font "courier 10 overstrike" update .b.l config -font $f } {} -test unixfont-8.1 {AllocFont procedure: use old font} { +test unixfont-8.1 {AllocFont procedure: use old font} unix { font create xyz button .c -font xyz font configure xyz -family times @@ -244,10 +245,10 @@ test unixfont-8.1 {AllocFont procedure: use old font} { destroy .c font delete xyz } {} -test unixfont-8.2 {AllocFont procedure: parse information from XLFD} { +test unixfont-8.2 {AllocFont procedure: parse information from XLFD} unix { expr {[lindex [font actual {-family times -size 0}] 3] == 0} } {0} -test unixfont-8.3 {AllocFont procedure: can't parse info from name} { +test unixfont-8.3 {AllocFont procedure: can't parse info from name} unix { catch {unset fontArray} # check that font actual returns the correct attributes. # the values of those attributes are system dependent. @@ -256,7 +257,7 @@ test unixfont-8.3 {AllocFont procedure: can't parse info from name} { catch {unset fontArray} set result } {-family -overstrike -size -slant -underline -weight} -test unixfont-8.4 {AllocFont procedure: classify characters} { +test unixfont-8.4 {AllocFont procedure: classify characters} unix { set x 0 incr x [font measure $courier "\u4000"] ;# 6 incr x [font measure $courier "\002"] ;# 4 @@ -264,38 +265,38 @@ test unixfont-8.4 {AllocFont procedure: classify characters} { incr x [font measure $courier "\101"] ;# 1 set x } [expr $cx*13] -test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} { +test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} unix { font metrics $courier -fixed } {1} -test unixfont-8.6 {AllocFont procedure: setup widths of special chars} { +test unixfont-8.6 {AllocFont procedure: setup widths of special chars} unix { set x 0 incr x [font measure $courier "\001"] ;# 4 incr x [font measure $courier "\002"] ;# 4 incr x [font measure $courier "\012"] ;# 2 set x } [expr $cx*10] -test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} { +test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} unix { catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1} set x {} } {} -test unixfont-8.8 {AllocFont procedure: no XA_UNDERLINE_POSITION} { +test unixfont-8.8 {AllocFont procedure: no XA_UNDERLINE_POSITION} unix { catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific} set x {} } {} -test unixfont-8.9 {AllocFont procedure: XA_UNDERLINE_THICKNESS} { +test unixfont-8.9 {AllocFont procedure: XA_UNDERLINE_THICKNESS} unix { catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1} set x {} } {} -test unixfont-8.10 {AllocFont procedure: no XA_UNDERLINE_THICKNESS} { +test unixfont-8.10 {AllocFont procedure: no XA_UNDERLINE_THICKNESS} unix { catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific} set x {} } {} -test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} { +test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} unix { catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1} set x {} } {} -test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} { +test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0\a0" set x {} @@ -304,7 +305,7 @@ test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} { lappend x [.b.c index $t @[expr $ax*2],0] lappend x [.b.c index $t @[expr $ax*3],0] } {0 1 1 2} -test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} { +test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0\0010" set x {} |