summaryrefslogtreecommitdiffstats
path: root/tests/font.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/font.test')
-rw-r--r--tests/font.test292
1 files changed, 150 insertions, 142 deletions
diff --git a/tests/font.test b/tests/font.test
index 643cc79..34e4b83 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -7,10 +7,7 @@
# All rights reserved.
package require tcltest 2.1
-namespace import -force tcltest::configure
-namespace import -force tcltest::testsDirectory
-configure -testdir [file join [pwd] [file dirname [info script]]]
-configure -loadfile [file join [testsDirectory] constraints.tcl]
+eval tcltest::configure $argv
tcltest::loadTestedCommands
catch {destroy .b}
@@ -49,11 +46,14 @@ proc csetup {{str ""}} {
setup
-case $tcl_platform(platform) {
- unix {set fixed "fixed"}
- windows {set fixed "courier 12"}
- macintosh {set fixed "monaco 9"}
+case [tk windowingsystem] {
+ x11 {set fixed "fixed"}
+ win32 {set fixed "courier 12"}
+ classic -
+ aqua {set fixed "monaco 9"}
}
+
+
set times [font actual {times 0} -family]
test font-1.1 {TkFontPkgInit} {
@@ -113,11 +113,11 @@ test font-4.1 {font command: actual: arguments} {
test font-4.2 {font command: actual: arguments} {
# (objc < 3)
list [catch {font actual} msg] $msg
-} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}}
test font-4.3 {font command: actual: arguments} {
# (objc - skip > 4) when skip == 0
list [catch {font actual xyz abc def} msg] $msg
-} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}}
test font-4.4 {font command: actual: displayof specified, so skip to next} {
catch {font actual xyz -displayof . -size}
} {0}
@@ -127,7 +127,7 @@ test font-4.5 {font command: actual: displayof specified, so skip to next} {
test font-4.6 {font command: actual: arguments} {
# (objc - skip > 4) when skip == 2
list [catch {font actual xyz -displayof . abc def} msg] $msg
-} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}}
test font-4.7 {font command: actual: arguments} {noExceed} {
# (tkfont == NULL)
list [catch {font actual "\{xyz"} msg] $msg
@@ -136,11 +136,11 @@ test font-4.8 {font command: actual: all attributes} {
# not (objc > 3) so objPtr = NULL
lindex [font actual {-family times}] 0
} {-family}
-test font-4.9 {font command: actual} {macOrUnix noExceed} {
+test font-4.9 {font command: actual} {unix noExceed} {
# (objc > 3) so objPtr = objv[3 + skip]
string tolower [font actual {-family times} -family]
} {times}
-test font-4.10 {font command: actual} {pcOnly} {
+test font-4.10 {font command: actual} win {
# (objc > 3) so objPtr = objv[3 + skip]
font actual {-family times} -family
} {Times New Roman}
@@ -307,8 +307,8 @@ test font-8.4 {font command: families} {
test font-9.1 {font command: measure: arguments} {
# (skip < 0)
- list [catch {font measure xyz -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
+ list [catch {expr {[font measure xyz -displayof]>0}} msg] $msg
+} {0 1}
test font-9.2 {font command: measure: arguments} {
# (objc - skip != 4)
list [catch {font measure} msg] $msg
@@ -325,6 +325,15 @@ test font-9.5 {font command: measure} {
# Tk_TextWidth()
expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
} {1}
+test font-9.6 {font command: measure -d} {
+ list [catch {expr {[font measure $fixed -d] > 0}} msg] $msg
+} {0 1}
+test font-9.7 {font command: measure -d with -displayof} {
+ list [catch {expr {[font measure $fixed -displayof . -d] > 0}} msg] $msg
+} {0 1}
+test font-9.8 {font command: measure: arguments} {
+ list [catch {font measure $fixed -displayof .} msg] $msg
+} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
test font-10.1 {font command: metrics: arguments} {
list [catch {font metrics xyz -displayof} msg] $msg
@@ -498,21 +507,16 @@ test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
setup
.b.f config -font {times 20}
} {}
-test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} {
+test font-15.7 {Tk_AllocFontFromObj procedure: get native font} unix {
# not (fontPtr == NULL)
setup
.b.f config -font fixed
} {}
-test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
+test font-15.8 {Tk_AllocFontFromObj procedure: get native font} win {
# not (fontPtr == NULL)
setup
.b.f config -font oemfixed
} {}
-test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
- # not (fontPtr == NULL)
- setup
- .b.f config -font application
-} {}
test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
# (fontPtr == NULL)
list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
@@ -649,7 +653,7 @@ proc psfontname {name} {
set start [string first "gsave" $post]
return [string range $post [expr $start+7] end]
}
-test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
+test font-21.1 {Tk_PostscriptFontName procedure: native} unix {
set x [font actual {{itc avant garde} 10} -family]
if {[string match *avant*garde $x]} {
psfontname "{itc avant garde} 10"
@@ -657,25 +661,16 @@ test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
set x {AvantGarde-Book}
}
} {AvantGarde-Book}
-test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.2 {Tk_PostscriptFontName procedure: native} win {
psfontname "arial 10"
} {Helvetica}
-test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.3 {Tk_PostscriptFontName procedure: native} win {
psfontname "{times new roman} 10"
} {Times-Roman}
-test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.4 {Tk_PostscriptFontName procedure: native} win {
psfontname "{courier new} 10"
} {Courier}
-test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
- psfontname "geneva 10"
-} {Helvetica}
-test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
- psfontname "{new york} 10"
-} {Times-Roman}
-test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
- psfontname "monaco 10"
-} {Courier}
-test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+test font-21.8 {Tk_PostscriptFontName procedure: spaces} unix {
set x [font actual {{lucida bright} 10} -family]
if {[string match lucida*bright $x]} {
psfontname "{lucida bright} 10"
@@ -683,80 +678,75 @@ test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
set x {LucidaBright}
}
} {LucidaBright}
-test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+test font-21.9 {Tk_PostscriptFontName procedure: spaces} unix {
psfontname "{new century schoolbook} 10"
} {NewCenturySchlbk-Roman}
set i 10
foreach p {
- {"avantgarde" AvantGarde-Book AvantGarde-Demi AvantGarde-BookOblique AvantGarde-DemiOblique}
- {"bookman" Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
- {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
- {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
- {"new century schoolbook" NewCenturySchlbk-Roman NewCenturySchlbk-Bold NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
- {"palatino" Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
- {"symbol" Symbol Symbol Symbol Symbol}
- {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
- {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
- {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
+ {font-21.10 "avantgarde"
+ AvantGarde-Book AvantGarde-Demi
+ AvantGarde-BookOblique AvantGarde-DemiOblique}
+ {font-21.11 "bookman"
+ Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
+ {font-21.12 "courier"
+ Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
+ {font-21.13 "helvetica"
+ Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+ {font-21.14 "new century schoolbook"
+ NewCenturySchlbk-Roman NewCenturySchlbk-Bold
+ NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
+ {font-21.15 "palatino"
+ Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
+ {font-21.16 "symbol"
+ Symbol Symbol Symbol Symbol}
+ {font-21.17 "times"
+ Times-Roman Times-Bold Times-Italic Times-BoldItalic}
+ {font-21.18 "zapfchancery"
+ ZapfChancery-MediumItalic ZapfChancery-MediumItalic
+ ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
+ {font-21.19 "zapfdingbats"
+ ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
} {
- test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
- set family [lindex $p 0]
+ set values [lassign $p testName family]
+ test $testName {Tk_PostscriptFontName procedure: exhaustive} unix {
set x {}
- set i 1
+ set j 0
foreach slant {roman italic} {
foreach weight {normal bold} {
set name [list $family 12 $slant $weight]
if {[font actual $name -family] == $family} {
lappend x [psfontname $name]
} else {
- lappend x [lindex $p $i]
+ lappend x [lindex $values $j]
}
- incr i
+ incr j
}
}
- incr i
set x
- } [lrange $p 1 end]
+ } $values
}
foreach p {
- {"arial" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
- {"courier new" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
- {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
- {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
- {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
+ {font-21.20 "arial"
+ Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+ {font-21.21 "courier new"
+ Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
+ {font-21.22 "helvetica"
+ Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+ {font-21.23 "symbol"
+ Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
+ {font-21.24 "times new roman"
+ Times-Roman Times-Bold Times-Italic Times-BoldItalic}
} {
- test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
- set family [lindex $p 0]
+ set values [lassign $p testName family]
+ test $testName {Tk_PostscriptFontName procedure: exhaustive} win {
set x {}
foreach slant {roman italic} {
foreach weight {normal bold} {
lappend x [psfontname [list $family 12 "$slant $weight"]]
}
}
- incr i
- set x
- } [lrange $p 1 end]
-}
-foreach p {
- {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
- {"geneva" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
- {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
- {"monaco" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
- {"new york" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
- {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
- {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
-} {
- test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
- set family [lindex $p 0]
- set x {}
- foreach slant {roman italic} {
- foreach weight {normal bold} {
- lappend x [psfontname [list $family 12 $slant $weight]]
- }
- }
- incr i
set x
- } [lrange $p 1 end]
+ } $values
}
test font-22.1 {Tk_TextWidth procedure} {
@@ -1152,48 +1142,47 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
test font-33.1 {Tk_TextWidth procedure} {
} {}
-test font-33.2 {ConfigAttributesObj procedure: arguments} {
+test font-34.1 {ConfigAttributesObj procedure: arguments} {
# (Tcl_GetIndexFromObj() != TCL_OK)
setup
list [catch {font create xyz -xyz} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-34.1 {ConfigAttributesObj procedure: arguments} {
+test font-34.2 {ConfigAttributesObj procedure: arguments} {
# (objc & 1)
setup
list [catch {font create xyz -family} msg] $msg
} {1 {value for "-family" option missing}}
-set i 3
foreach p {
- {family xyz times}
- {size 20 40}
- {weight normal bold}
- {slant roman italic}
- {underline 0 1}
- {overstrike 0 1}
+ {font-34.3 family xyz times}
+ {font-34.4 size 20 40}
+ {font-34.5 weight normal bold}
+ {font-34.6 slant roman italic}
+ {font-34.7 underline 0 1}
+ {font-34.8 overstrike 0 1}
} {
- set opt [lindex $p 0]
- test font-34.$i "ConfigAttributesObj procedure: $opt" {
+ lassign $p testName opt val1 val2
+ test $testName "ConfigAttributesObj procedure: $opt" {
setup
set x {}
- font create xyz -$opt [lindex $p 1]
+ font create xyz -$opt $val1
lappend x [font config xyz -$opt]
- font config xyz -$opt [lindex $p 2]
+ font config xyz -$opt $val2
lappend x [font config xyz -$opt]
- } [lrange $p 1 2]
- incr i
+ } [list $val1 $val2]
}
foreach p {
- {size xyz {1 {expected integer but got "xyz"}}}
- {weight xyz {1 {bad -weight value "xyz": must be normal, or bold}}}
- {slant xyz {1 {bad -slant value "xyz": must be roman, or italic}}}
- {underline xyz {1 {expected boolean value but got "xyz"}}}
- {overstrike xyz {1 {expected boolean value but got "xyz"}}}
+ {font-34.9 size xyz {expected integer but got "xyz"}}
+ {font-34.10 weight xyz {bad -weight value "xyz": must be normal, or bold}}
+ {font-34.11 slant xyz {bad -slant value "xyz": must be roman, or italic}}
+ {font-34.12 underline xyz {expected boolean value but got "xyz"}}
+ {font-34.13 overstrike xyz {expected boolean value but got "xyz"}}
} {
- test font-34.$i "ConfigAttributesObj procedure: [lindex $p 0]" {
+ lassign $p testName opt val result
+ test $testName "ConfigAttributesObj procedure: $opt" -setup {
setup
- list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
- } [lindex $p 2]
- incr i
+ } -body {
+ font create xyz -$opt $val
+ } -returnCodes error -result $result
}
test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
@@ -1202,12 +1191,14 @@ test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
font create xyz -family xyz
font config xyz -family
} {xyz}
+
test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} {
# (Tcl_GetIndexFromObj() != TCL_OK)
setup
font create xyz
list [catch {font config xyz -xyz} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+
test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
# not (objPtr != NULL)
setup
@@ -1216,19 +1207,20 @@ test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
set i 4
foreach p {
- {family xyz xyz}
- {size 20 20}
- {weight normal normal}
- {slant italic italic}
- {underline yes 1}
- {overstrike false 0}
+ {font-37.2 family xyz xyz}
+ {font-37.3 size 20 20}
+ {font-37.4 weight normal normal}
+ {font-37.5 slant italic italic}
+ {font-37.6 underline yes 1}
+ {font-37.7 overstrike false 0}
} {
- test font-31.$i "GetAttributeInfo procedure: [lindex $p 0]" {
+ lassign $p testName opt val expected
+ test $testName "GetAttributeInfo procedure: $opt" -setup {
setup
- font create xyz -[lindex $p 0] [lindex $p 1]
- font config xyz -[lindex $p 0]
- } [lindex $p 2]
- incr i
+ } -body {
+ font create xyz -$opt $val
+ font config xyz -$opt
+ } -result $expected
}
# In tests below, one field is set to "xyz" so that font name doesn't
@@ -1267,15 +1259,18 @@ test font-38.9 {ParseFontNameObj procedure: arguments} {
test font-38.10 {ParseFontNameObj procedure: arguments} {
list [catch {font actual {times xyz xyz}} msg] $msg
} {1 {expected integer but got "xyz"}}
-test font-38.11 {ParseFontNameObj procedure: stylelist loop} {macOnly} {
- lrange [font actual {times 12 bold italic overstrike underline}] 4 end
-} {-weight bold -slant italic -underline 1 -overstrike 0}
test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} {
lrange [font actual {times 12 bold italic overstrike underline}] 4 end
} {-weight bold -slant italic -underline 1 -overstrike 1}
test font-38.13 {ParseFontNameObj procedure: stylelist error} {
list [catch {font actual {times 12 bold xyz}} msg] $msg
} {1 {unknown font style "xyz"}}
+test font-38.14 "ParseFontNameObj: options with hyphenated family: bug #2791352" -body {
+ font actual {-family sans-serif -size 12 -weight bold -slant roman -underline 0 -overstrike 0}
+} -returnCodes ok -result [font actual {sans-serif 12 bold}]
+test font-38.15 "ParseFontNameObj: bug #2791352" -body {
+ font actual {-invalidfont 8 bold}
+} -returnCodes error -match glob -result {bad option "-invalidfont": *}
test font-39.1 {NewChunk procedure: test realloc} {
.b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
@@ -1344,35 +1339,48 @@ tk scaling $oldscale
test font-45.1 {TkFontGetAliasList: no match} {
font actual {snarky 10} -family
} [font actual {-size 10} -family]
-test font-45.2 {TkFontGetAliasList: match} {macOnly} {
- # Result could be either "Times" or "New York"
- font actual {{times new roman} 10} -family
-} [font actual {times 10} -family]
-test font-45.3 {TkFontGetAliasList: match} {pcOnly} {
+test font-45.3 {TkFontGetAliasList: match} win {
font actual {times 10} -family
} {Times New Roman}
-test font-45.4 {TkFontGetAliasList: match} {unixOnly noExceed} {
+test font-45.4 {TkFontGetAliasList: match} {unix noExceed} {
# can fail on Unix systems that have a real "times new roman" font
font actual {{times new roman} 10} -family
} [font actual {times 10} -family]
+test font-46.1 {font actual, with character, no option, no --} \
+ -body {
+ font actual {times 10} a
+ } \
+ -match glob \
+ -result [list -family [font actual {times 10} -family] -size *\
+ -slant roman -underline 0 -overstrike 0]
+
+test font-46.2 {font actual, with character introduced by --} \
+ -body {
+ font actual {times 10} -- -
+ } \
+ -match glob \
+ -result [list -family [font actual {times 10} -family] -size *\
+ -slant roman -underline 0 -overstrike 0]
+
+test font-46.3 {font actual, with character and option} {
+ font actual {times 10} -family a
+} [font actual {times 10} -family]
+
+test font-46.4 {font actual, with character, option and --} {
+ font actual {times 10} -family -- -
+} [font actual {times 10} -family]
+
+test font-46.5 {font actual, too many chars} {
+ list [catch {
+ font actual {times 10} 123456789012345678901234567890123456789012345678901
+ } result] $result
+} {1 {expected a single character but got "1234567890123456789012345678901234567..."}}
+
setup
destroy .b
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-