path: root/tests/font.test

# This file is a Tcl script to test out Tk's "font" command
# plus the procedures in tkFont.c.  It is organized in the
# standard white-box fashion for Tcl tests.
#
# Copyright (c) 1996-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: font.test,v 1.17.2.1 2009/05/13 21:49:12 patthoyts Exp $

package require tcltest 2.1
eval tcltest::configure $argv
tcltest::loadTestedCommands

catch {destroy .b}
toplevel .b
wm geom .b +0+0
update idletasks

proc setup {} {
    catch {destroy .b.f}
    catch {eval font delete [font names]}
    label .b.f 
    pack .b.f
    update
}

label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Courier -12"
pack .b.l
canvas .b.c -closeenough 0 
.b.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
pack .b.c
update

set ax [winfo reqwidth .b.l]
set ay [winfo reqheight .b.l]
proc getsize {} {
    update
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}

proc csetup {{str ""}} {
    focus -force .b.c
    .b.c dchars text 0 end
    .b.c insert text 0 $str
    .b.c focus text
}

setup

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} {
    catch {interp delete foo}
    interp create foo
    foo eval {
	load {} Tk
	wm geometry . +0+0
	update
    }
    interp delete foo
} {}

test font-2.1 {TkFontPkgFree} {
    catch {interp delete foo}
    interp create foo
    set x {}

    # Makes sure that named font was visible only to child interp.

    foo eval {
	load {} Tk
	wm geometry . +0+0
	button .b -font {times 16} -text "hi"
	pack .b
	font create wiggles -family courier -underline 1
	update
    }
    lappend x [catch {font configure wiggles} msg; set msg]

    # Tests cancelling the idle handler for TheWorldHasChanged,
    # because app goes away before idle serviced.
    
    foo eval {
	.b config -font wiggles
	font config wiggles -size 24
	destroy .
    }
    lappend x [foo eval {catch {font families} msg; set msg}]

    interp delete foo
    set x
} {{named font "wiggles" doesn't exist} {can't invoke "font" command:  application has been destroyed}}


test font-3.1 {font command: general} {
    list [catch {font} msg] $msg
} {1 {wrong # args: should be "font option ?arg?"}}
test font-3.2 {font command: general} {
    list [catch {font xyz} msg] $msg
} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}

test font-4.1 {font command: actual: arguments} {
    # (skip < 0)
    list [catch {font actual xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
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? ?--? ?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? ?--? ?char?"}}
test font-4.4 {font command: actual: displayof specified, so skip to next} {
    catch {font actual xyz -displayof . -size}
} {0}
test font-4.5 {font command: actual: displayof specified, so skip to next} {
    lindex [font actual xyz -displayof .] 0
} {-family}
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? ?--? ?char?"}}
test font-4.7 {font command: actual: arguments} {noExceed} {
    # (tkfont == NULL)
    list [catch {font actual "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
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} {unix noExceed} {
    # (objc > 3) so objPtr = objv[3 + skip]
    string tolower [font actual {-family times} -family]
} {times}
test font-4.10 {font command: actual} win {
    # (objc > 3) so objPtr = objv[3 + skip]
    font actual {-family times} -family
} {Times New Roman}
test font-4.11 {font command: bad option} {
    list [catch {font actual xyz -style} msg] $msg
} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}

test font-5.1 {font command: configure} {
    # (objc < 3) 
    list [catch {font configure} msg] $msg
} {1 {wrong # args: should be "font configure fontname ?options?"}}
test font-5.2 {font command: configure: non-existent font} {
    # (namedHashPtr == NULL)
    list [catch {font configure xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-5.3 {font command: configure: "deleted" font} {
    # (nfPtr->deletePending != 0) 
    setup
    font create xyz
    .b.f configure -font xyz
    font delete xyz
    list [catch {font configure xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-5.4 {font command: configure: get all options} {
    # (objc == 3) so objPtr = NULL
    setup
    font create xyz -family xyz
    lindex [font configure xyz] 1
} xyz
test font-5.5 {font command: configure: get one option} {
    # (objc == 4) so objPtr = objv[3]
    setup
    font create xyz -family xyz
    font configure xyz -family
} xyz
test font-5.6 {font command: configure: update existing font} {
    # else result = ConfigAttributesObj()
    setup
    font create xyz
    font configure xyz -family xyz
    update
    font configure xyz -family
} xyz
test font-5.7 {font command: configure: bad option} {
    setup
    font create xyz
    list [catch {font configure xyz -style} msg] $msg
} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}

test font-6.1 {font command: create: make up name} {
    # (objc < 3) so name = NULL
    setup
    font create
    font names
} {font1}
test font-6.2 {font command: create: name specified} {
    # not (objc < 3)
    setup
    font create xyz
    font names
} {xyz}
test font-6.3 {font command: create: name not really specified} {
    # (name[0] == '-') so name = NULL
    setup
    font create -family xyz
    font names
} {font1}
test font-6.4 {font command: create: generate name} {
    # (name == NULL)
    setup
    font create -family one
    font create -family two
    font create -family three
    font delete font2
    font create -family four
    font configure font2 -family
} {four}
test font-6.5 {font command: create: bad option creating new font} {
    # name was specified so skip = 3 
    setup
    list [catch {font create xyz -xyz times} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
test font-6.6 {font command: create: bad option creating new font} {
    # name was not specified so skip = 2 
    setup
    list [catch {font create -xyz times} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
test font-6.7 {font command: create: already exists} {
    # (CreateNamedFont() != TCL_OK)
    setup
    font create xyz
    list [catch {font create xyz} msg] $msg
} {1 {named font "xyz" already exists}}

test font-7.1 {font command: delete: arguments} {
    # (objc < 3) 
    list [catch {font delete} msg] $msg
} {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
test font-7.2 {font command: delete: loop test} {
    # for (i = 2; i < objc; i++) 
    setup
    set x {}
    font create a -underline 1
    font create b -underline 1
    font create c -underline 1
    font create d -underline 1
    font create e -underline 1
    lappend x [lsort [font names]]
    font delete a e c b
    lappend x [lsort [font names]]
} {{a b c d e} d}
test font-7.3 {font command: delete: loop test} {
    # (namedHashPtr == NULL) in middle of loop
    setup
    set x {}
    font create a -underline 1
    font create b -underline 1
    font create c -underline 1
    font create d -underline 1
    font create e -underline 1
    lappend x [lsort [font names]]
    catch {font delete a d q c e b}
    lappend x [lsort [font names]]
} {{a b c d e} {b c e}}
test font-7.4 {font command: delete: non-existent} {
    # (namedHashPtr == NULL) 
    setup
    list [catch {font delete xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-7.5 {font command: delete: mark for later deletion} {
    # (nfPtr->refCount != 0)
    setup
    font create xyz
    .b.f configure -font xyz
    font delete xyz
    font actual xyz
    list [catch {font configure xyz} msg] $msg [.b.f cget -font]
} {1 {named font "xyz" doesn't exist} xyz}
test font-7.6 {font command: delete: actually delete} {
    # not (nfPtr->refCount != 0)
    setup
    font create xyz -underline 1
    font delete xyz
    catch {font config xyz}
} {1}
setup

test font-8.1 {font command: families: arguments} {
    # (skip < 0)
    list [catch {font families -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-8.2 {font command: families: arguments} {
    # (objc - skip != 2) when skip == 0
    list [catch {font families xyz} msg] $msg
} {1 {wrong # args: should be "font families ?-displayof window?"}}
test font-8.3 {font command: families: arguments} {
    # (objc - skip != 2) when skip == 2
    list [catch {font families -displayof . xyz} msg] $msg
} {1 {wrong # args: should be "font families ?-displayof window?"}}
test font-8.4 {font command: families} {
    # TkpGetFontFamilies()
    regexp -nocase times [font families]
} {1}

test font-9.1 {font command: measure: arguments} {
    # (skip < 0)
    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
} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
test font-9.3 {font command: measure: arguments} {
    # (objc - skip != 4) 
    list [catch {font measure xyz abc def} msg] $msg
} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
test font-9.4 {font command: measure: arguments} {noExceed} {
    # (tkfont == NULL)
    list [catch {font measure "\{xyz" abc} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
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
} {1 {value for "-displayof" missing}}
test font-10.2 {font command: metrics: arguments} {
    # (skip < 0)
    list [catch {font metrics xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-10.3 {font command: metrics: arguments} {
    # (objc < 3) 
    list [catch {font metrics} msg] $msg
} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
test font-10.4 {font command: metrics: arguments} {
    # (objc - skip) > 4) when skip == 0
    list [catch {font metrics xyz abc def} msg] $msg
} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
test font-10.5 {font command: metrics: arguments} {
    # (objc - skip) > 4) when skip == 2
    list [catch {font metrics xyz -displayof . abc} msg] $msg
} {1 {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}}
test font-10.6 {font command: metrics: bad font} {noExceed} {
    # (tkfont == NULL)
    list [catch {font metrics "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-10.7 {font command: metrics: get all metrics} {
    # (objc == 3)
    catch {unset a}
    array set a [font metrics {-family xyz}]
    set x [lsort [array names a]]
    unset a
    set x    
} {-ascent -descent -fixed -linespace}
test font-10.8 {font command: metrics: bad metric} {
    # (Tcl_GetIndexFromObj() != TCL_OK)
    list [catch {font metrics $fixed -xyz} msg] $msg
} {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}
test font-10.9 {font command: metrics: get individual metrics} {
    font metrics $fixed -ascent
    font metrics $fixed -descent
    font metrics $fixed -linespace
    font metrics $fixed -fixed
} {1}

test font-11.1 {font command: names: arguments} {
    # (objc != 2)
    list [catch {font names xyz} msg] $msg
} {1 {wrong # args: should be "font names"}}
test font-11.2 {font command: names: loop test: no passes} {
    setup
    font names
} {}
test font-11.3 {font command: names: loop test: one pass} {
    setup
    font create
    font names
} {font1}
test font-11.4 {font command: names: loop test: multiple passes} {
    setup
    font create xyz
    font create abc
    font create def
    lsort [font names]
} {abc def xyz}
test font-11.5 {font command: names: skip deletePending fonts} {
    # (nfPtr->deletePending == 0)
    setup
    set x {}
    font create xyz
    font create abc
    lappend x [lsort [font names]]
    .b.f config -font xyz
    font delete xyz
    lappend x [font names]
} {{abc xyz} abc}

test font-12.1 {UpdateDependantFonts procedure: no users} {
    # (nfPtr->refCount == 0)
    setup
    font create xyz
    font configure xyz -family times
} {}
test font-12.2 {UpdateDependantFonts procedure: pings the widgets} {
    setup
    font create xyz -family times -size 20
    .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
    set a1 [font measure xyz "abcd"]
    update
    set b1 [winfo reqwidth .b.f]
    font configure xyz -family helvetica -size 20
    set a2 [font measure xyz "abcd"]
    update
    set b2 [winfo reqwidth .b.f]
    expr {$a1==$b1 && $a2==$b2}
} {1}

test font-13.1 {CreateNamedFont: new named font} {
    # not (new == 0)
    setup
    set x {}
    lappend x [font names]
    font create xyz
    lappend x [font names]
} {{} xyz}
test font-13.2 {CreateNamedFont: named font already exists} {
    # (new == 0)
    setup
    font create xyz
    list [catch {font create xyz} msg] $msg
} {1 {named font "xyz" already exists}}
test font-13.3 {CreateNamedFont: named font already exists} {
    # (nfPtr->deletePending == 0)
    setup
    font create xyz
    list [catch {font create xyz} msg] $msg
} {1 {named font "xyz" already exists}}
test font-13.4 {CreateNamedFont: recreate "deleted" font} {
    # not (nfPtr->deletePending == 0)
    setup
    font create xyz -family times
    .b.f configure -font xyz
    font delete xyz
    font create xyz -family courier
    font configure xyz -family
} {courier}

test font-14.1 {Tk_GetFont procedure} {
} {}

test font-15.1 {Tk_AllocFontFromObj - converting internal reps} testfont {
    set x {Times 16}
    lindex $x 0
    destroy .b1 .b2
    button .b1 -font $x
    lindex $x 0
    testfont counts {Times 16}
} {{1 0}}
test font-15.2 {Tk_AllocFontFromObj - discard stale font} testfont {
    set x {Times 16}
    destroy .b1 .b2
    button .b1 -font $x
    destroy .b1
    set result {}
    lappend result [testfont counts {Times 16}]
    button .b2 -font $x
    lappend result [testfont counts {Times 16}]
} {{} {{1 1}}}
test font-15.3 {Tk_AllocFontFromObj - reuse existing font} testfont {
    set x {Times 16}
    destroy .b1 .b2
    button .b1 -font $x
    set result {}
    lappend result [testfont counts {Times 16}]
    button .b2 -font $x
    pack .b1 .b2 -side top
    lappend result [testfont counts {Times 16}]
} {{{1 1}} {{2 1}}}
test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} {
    # (new == 0)
    setup
    .b.f config -font {-family fixed}
    lindex [font actual {-family fixed}] 0
} {-family}
test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
    # (namedHashPtr != NULL) 
    setup
    font create xyz 
    .b.f config -font xyz 
} {}
test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
    # not (namedHashPtr != NULL)
    setup
    .b.f config -font {times 20}
} {}
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} win {
    # not (fontPtr == NULL) 
    setup
    .b.f config -font oemfixed
} {}
test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
    # (fontPtr == NULL) 
    list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
} {1 {expected integer but got "yyy"}}
test font-15.11 {Tk_AllocFontFromObj procedure: no match} {noExceed} {
    # (ParseFontNameObj() != TCL_OK)
    list [catch {font actual "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-15.12 {Tk_AllocFontFromObj procedure: get attribute font} {
    # not (ParseFontNameObj() != TCL_OK)
    lindex [font actual {plan 9}] 0
} {-family}
test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} {
    # Tk_MeasureChars(fontPtr, "0", ...)
    label .l -bd 0 -padx 0  -highlightthickness 0 -font $fixed -text "a\tb"
    update
    set x [winfo reqwidth .l]
    destroy .l
    set x
} [expr [font measure $fixed "0"]*9]
test font-15.14 {Tk_AllocFontFromObj procedure: underline position} {
    # (fontPtr->underlineHeight == 0) because size was < 10
    setup
    .b.f config -text "underline" -font "times -8 underline"
    update
} {}    

test font-16.1 {Tk_NameOfFont procedure} {
    setup
    .b.f config -font -family\ fixed
    .b.f cget -font
} {-family fixed}

test font-17.1 {Tk_FreeFontFromObj - reference counts} testfont {
    set x {Courier 12}
    destroy .b1 .b2 .b3
    button .b1 -font $x
    button .b3 -font $x
    button .b2 -font $x
    set result {}
    lappend result [testfont counts {Courier 12}]
    destroy .b1
    lappend result [testfont counts {Courier 12}]
    destroy .b2
    lappend result [testfont counts {Courier 12}]
    destroy .b3
    lappend result [testfont counts {Courier 12}]
} {{{3 1}} {{2 1}} {{1 1}} {}}
test font-17.2 {Tk_FreeFont procedure: one ref} {
    # (fontPtr->refCount == 0)
    setup
    .b.f config -font {-family fixed}
    destroy .b.f
} {}
test font-17.3 {Tk_FreeFont procedure: multiple ref} {
    # not (fontPtr->refCount == 0)
    setup
    .b.f config -font {-family fixed}
    button .b.b -font {-family fixed}
    destroy .b.f
    set x [.b.b cget -font]
    destroy .b.b
    set x
} {-family fixed}
test font-17.4 {Tk_FreeFont procedure: named font} {
    # (fontPtr->namedHashPtr != NULL) 
    setup
    font create xyz
    .b.f config -font xyz
    destroy .b.f
    font names
} {xyz}
test font-17.5 {Tk_FreeFont procedure: named font} {
    # not (fontPtr->refCount == 0) 
    setup
    font create xyz -underline 1
    .b.f config -font xyz
    font delete xyz
    set x [font actual xyz -underline]
    destroy .b.f
    list [font actual xyz -underline] $x
} {0 1}
test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
    setup
    font create xyz 
    .b.f config -font xyz
    button .b.b -font xyz
    font delete xyz
    set x [font actual xyz]
    destroy .b.b
    list [lindex [font actual xyz] 0] [lindex $x 0]
} {-family -family}

test font-18.1 {FreeFontObjProc} testfont {
    destroy .b1
    set x [format {Courier 12}]
    button .b1 -font $x
    set y [format {Courier 12}]
    .b1 configure -font $y
    set z [format {Courier 12}]
    .b1 configure -font $z
    set result {}
    lappend result [testfont counts {Courier 12}]
    set x red
    lappend result [testfont counts {Courier 12}]
    set z 32
    lappend result [testfont counts {Courier 12}]
    destroy .b1
    lappend result [testfont counts {Courier 12}]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}

test font-19.1 {Tk_FontId} {
    .b.f config -font "times 20"
    update
} {}

test font-20.1 {Tk_GetFontMetrics procedure} {
    button .b.w1 -text abc
    entry .b.w2 -text abcd
    update
    destroy .b.w1 .b.w2
} {}

proc psfontname {name} {
    set a [.b.c itemcget text -font]
    .b.c itemconfig text -text "We need text" -font $name
    set post [.b.c postscript]
    .b.c itemconfig text -font $a
    set end [string first "findfont" $post]
    incr end -2
    set post [string range $post [expr $end-70] $end]
    set start [string first "gsave" $post]
    return [string range $post [expr $start+7] end]
}
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"
    } else {
	set x {AvantGarde-Book}
    }
} {AvantGarde-Book}
test font-21.2 {Tk_PostscriptFontName procedure: native} win {
    psfontname "arial 10"
} {Helvetica}
test font-21.3 {Tk_PostscriptFontName procedure: native} win {
    psfontname "{times new roman} 10"
} {Times-Roman}
test font-21.4 {Tk_PostscriptFontName procedure: native} win {
    psfontname "{courier new} 10"
} {Courier}
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"
    } else {
	set x {LucidaBright}
    }
} {LucidaBright}
test font-21.9 {Tk_PostscriptFontName procedure: spaces} unix {
    psfontname "{new century schoolbook} 10"
} {NewCenturySchlbk-Roman}
set i 10
foreach p {
    {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}
} {
    set values [lassign $p testName family]
    test $testName {Tk_PostscriptFontName procedure: exhaustive} unix {
	set x {}
	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 $values $j]
		}
		incr j
	    }
	}
	set x
    } $values
}
foreach p {
    {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}
} {
    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"]]
	    }
	}
	set x
    } $values
}

test font-22.1 {Tk_TextWidth procedure} {
    font measure [.b.l cget -font] "000"
} [expr $ax*3]

test font-23.1 {Tk_UnderlineChars procedure} {
    text .b.t
    .b.t insert 1.0 abc\tdefg
    .b.t tag config sel -underline 1
    .b.t tag add sel 1.0 end
    update
} {}

setup
test font-24.1 {Tk_ComputeTextLayout: empty string} {
    .b.l config -text ""
} {}
test font-24.2 {Tk_ComputeTextLayout: simple string} {
    .b.l config -text "000"
    getsize
} "[expr $ax*3] $ay"
test font-24.3 {Tk_ComputeTextLayout: find special chars} {
    .b.l config -text "000\n000"
    getsize
} "[expr $ax*3] [expr $ay*2]"
test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
    .b.l config -text "000\n000"
    getsize
} "[expr $ax*3] [expr $ay*2]"
test font-24.5 {Tk_ComputeTextLayout: break line} {
    .b.l config -text "000\t00000" -wrap [expr 9*$ax]
    set x [getsize]
    .b.l config -wrap 0
    set x
} "[expr 8*$ax] [expr 2*$ay]"
test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
    .b.l config -text "000\n000"
} {}
test font-24.7 {Tk_ComputeTextLayout: special char was \n} {
    .b.l config -text "000\n0000"
    getsize
} "[expr $ax*4] [expr $ay*2]"
test font-24.8 {Tk_ComputeTextLayout: special char was \t} {
    .b.l config -text "000\t00"
    getsize
} "[expr $ax*10] $ay"
test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
    set x {}
    .b.l config -text "000\t000"
    lappend x [getsize]
    .b.l config -text "000\t000" -wrap [expr 100*$ax]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
    set x {}
    .b.l config -text "000\t"
    lappend x [getsize]
    .b.l config -text "000\t00" -wrap [expr $ax*6]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
    set x {}
    .b.l config -text "000            000" -wrap [expr $ax*5]
    lappend x [getsize]
    .b.l config -text "000            "
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
    set x {}
    .b.l config -text "000            0000" -wrap [expr $ax*5]
    lappend x [getsize]
    .b.l config -text "000\t00            0000" -wrap [expr $ax*12]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
    .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
    getsize
} "1 [expr $ay*129]"
test font-24.14 {Tk_ComputeTextLayout: text ended with \n} {
    list [.b.l config -text "0000"; getsize] [.b.l config -text "0000\n"; getsize]
} "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}"
test font-24.15 {Tk_ComputeTextLayout: justification} {
    csetup "000\n00000"
    set x {}
    .b.c itemconfig text -just left
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just center
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just right
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just left
    set x
} {2 1 0}

test font-25.1 {Tk_FreeTextLayout procedure} {
    setup
    .b.f config -text foo
    .b.f config -text boo
} {}
    
test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
    .b.f config -text foo
} {}
test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
    csetup "000\t00\n000"
} {}
test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
    csetup "000\t00"
    .b.c select from text 3
    .b.c select to text 5
} {}
test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
    .b.c select from text 3
    .b.c select to text 5
} {}
test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
    .b.c select from text 2
    .b.c select to text 2
} {}
test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
    .b.c select from text 4
    .b.c select to text 4
} {}

test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
    .b.f config -text "foo" -under -1
} {}
test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
} {}
test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 5
    .b.f config -wrap -1 -under -1
} {}
    
test font-28.1 {Tk_PointToChar procedure: above all lines} {
    csetup "000"
    .b.c index text @-1,0
} {0}
test font-28.2 {Tk_PointToChar procedure: no chars} {
    # After fixing the following bug:
    #
    # In canvas text item, it was impossible to click to position the
    # insertion point just after the last character.
    #
    # introduced another bug that Tk_PointToChar() would return a character
    # index of 1 if TextLayout contained 0 characters.

    csetup ""
    .b.c index text @100,100
} {0}
test font-28.3 {Tk_PointToChar procedure: loop test} {
    csetup "000\n000\n000\n000"
    .b.c index text @10000,0
} {3}
test font-28.4 {Tk_PointToChar procedure: intersect line} {
    csetup "000\n000\n000"
    .b.c index text @0,$ay
} {4}
test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
    .b.c index text @-100,$ay
} {4}
test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
    .b.c index text @100000,$ay
} {7}
test font-28.7 {Tk_PointToChar procedure: which chunk on this line} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*2],$ay
} {6}
test font-28.8 {Tk_PointToChar procedure: which chunk on this line} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*10],$ay
} {10}
test font-28.9 {Tk_PointToChar procedure: in special chunk} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*6],$ay
} {7}
test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} {
    csetup "000 0000000"
    .b.c itemconfig text -width [expr $ax*5]
    set x [.b.c index text @[expr $ax*5],0]
    .b.c itemconfig text -width 0
    set x
} {3}
test font-28.11 {Tk_PointToChar procedure: below all chunks} {
    csetup "000 0000000"
    .b.c index text @0,1000000
} {11}
    
test font-29.1 {Tk_CharBBox procedure: index < 0} {
    .b.f config -text "000" -underline -1
} {}
test font-29.2 {Tk_CharBBox procedure: loop} {
    .b.f config -text "000\t000\t000\t000" -underline 9
} {}
test font-29.3 {Tk_CharBBox procedure: special char} {
    .b.f config -text "000\t000\t000" -underline 7
} {}
test font-29.4 {Tk_CharBBox procedure: normal char} {
    .b.f config -text "000" -underline 1
} {}
test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 2
    .b.f config -wrap 0
} {}
test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 3
    .b.f config -wrap 0
} {}

.b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}

test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} {
    csetup "000\n000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {0}
test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} {
    csetup "000\n000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y $ay
    set x
} {5}
test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} {
    csetup "000\n0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
    set x
} {}
test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} {
    csetup "000\t000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*6] -y 0
    set x
} {3}
test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} {
    csetup "000\n0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
    set x
} {}
test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} {
    csetup "000\n000      000000000"
    .b.c itemconfig text -width [expr $ax*10]
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*5] -y $ay
    .b.c itemconfig text -width 0
    set x
} {}
.b.c itemconfig text -justify center
test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {}
test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y 0
    set x
} {}
test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y 0
    set x
} {0}
test font-30.10 {Tk_DistanceToTextLayout procedure: above line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {}
test font-30.11 {Tk_DistanceToTextLayout procedure: below line} {
    csetup "000\n0"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y $ay
    set x
} {}
test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y $ay
    set x
} {3}
.b.c itemconfig text -justify left
test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
    csetup "000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y 0
    set x
} {1}

test font-31.1 {Tk_IntersectTextLayout procedure: loop once} {
    csetup "000\n000\n000"
    .b.c find overlapping 0 0 0 0
} [.b.c find withtag text]
test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} {
    csetup "000\t000\t000"
    .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
} [.b.c find withtag text]
test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} {
    csetup "0\n000"
    .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
} {}
test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} {
    csetup "000\t000"
    .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
} [.b.c find withtag text]
test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} {
    csetup "000\n0\n000"
    .b.c find overlapping $ax $ay $ax $ay
} {}
test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} {
    csetup "000\n000      000000000"
    .b.c itemconfig text -width [expr $ax*10]
    set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
    .b.c itemconfig text -width 0
    set x
} {}

test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
    # If there were a whole bunch of returns or tabs in a row, then the
    # temporary buffer could overflow and write on the stack.
    
    csetup "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
    .b.c itemconfig text -width 800
    .b.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
    .b.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
    .b.c insert text end "end"
    set x [.b.c postscript]
    set i [string first "(qwerty" $x] 
    string range $x $i [expr {$i + 278}]
} {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
[(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[()]
[(end)]
}

test font-33.1 {Tk_TextWidth procedure} {
} {}

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.2 {ConfigAttributesObj procedure: arguments} {
    # (objc & 1)
    setup
    list [catch {font create xyz -family} msg] $msg
} {1 {value for "-family" option missing}}
foreach p {
    {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}
} {
    lassign $p testName opt val1 val2
    test $testName "ConfigAttributesObj procedure: $opt" {
	setup
	set x {}
	font create xyz -$opt $val1
	lappend x [font config xyz -$opt]
	font config xyz -$opt $val2
	lappend x [font config xyz -$opt]
    } [list $val1 $val2]
}
foreach p {
    {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"}}
} {
    lassign $p testName opt val result
    test $testName "ConfigAttributesObj procedure: $opt" -setup {
	setup
    } -body {
	font create xyz -$opt $val
    } -returnCodes error -result $result
}

test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
    # (objPtr != NULL)
    setup
    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
    font create xyz -family xyz
    font config xyz
} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
set i 4
foreach p {
    {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}
} {
    lassign $p testName opt val expected
    test $testName "GetAttributeInfo procedure: $opt" -setup {
	setup
    } -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
# look like a native X font, so that ParseFontNameObj or TkParseXLFD will
# be called.

setup

test font-38.1 {ParseFontNameObj procedure: begins with -} {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.2 {ParseFontNameObj procedure: begins with -*} {
    lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
    lindex [font actual {-family times}] 1
} $times
test font-38.5 {ParseFontNameObj procedure: begins with *} {
    lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.6 {ParseFontNameObj procedure: begins with *} {
    font actual *-times-xyz -family
} $times
test font-38.7 {ParseFontNameObj procedure: arguments} {noExceed} {
    list [catch {font actual "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-38.8 {ParseFontNameObj procedure: arguments} {noExceed} {
    list [catch {font actual ""} msg] $msg
} {1 {font "" doesn't exist}}
test font-38.9 {ParseFontNameObj procedure: arguments} {
    list [catch {font actual {times 20 xyz xyz}} msg] $msg
} {1 {unknown font style "xyz"}}
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.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"
} {}

test font-40.1 {TkFontParseXLFD procedure: initial dash} {
    font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
} $times
test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
    font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
} $times
test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
    font actual -xyz-times-*-*-* -family
} $times
test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
    lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
} {-family}
test font-40.5 {TkFontParseXLFD procedure: all fields specified} {
    lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
} $times
test font-41.1 {TkParseXLFD procedure: arguments} {
    # XLFD with bad pointsize: fallback to some system font.
    font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
    set x {}
} {}
test font-42.1 {TkFontParseXLFD procedure: arguments} {
    # XLFD with bad pixelsize: fallback to some system font.
    font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
    set x {}
} {}
test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
    font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
    set x {}
} {}
test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} {
    font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
    set x {}
} {}
test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
    font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
    set x {}
} {}
test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} {
    font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
    set x {}
} {}

test font-43.1 {FieldSpecified procedure: specified vs. non-specified} {
    font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
    font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
    font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times

set oldscale [tk scaling]
tk scaling 0.5
test font-44.1 {TkFontGetPixels: size < 0} {
    font actual {times -12} -size
} {24}
test font-44.2 {TkFontGetPoints: size >= 0} {noExceed} {
    font actual {times 12} -size
} {12}

tk scaling $oldscale

test font-45.1 {TkFontGetAliasList: no match} {
    font actual {snarky 10} -family
} [font actual {-size 10} -family]
test font-45.3 {TkFontGetAliasList: match} win {
    font actual {times 10} -family
} {Times New Roman}
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
cleanupTests
return