Initial revision

1 files changed, 1092 insertions, 0 deletions

diff --git a/tests/font.test b/tests/font.test
new file mode 100644
index 0000000..a526470
--- /dev/null
+++ b/tests/font.test
@@ -0,0 +1,1092 @@
+# 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 fashion for Tcl tests.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) font.test 1.22 97/10/10 14:34:54
+
+if {[string compare test [info procs test]] != 0} {
+    source defs
+}
+
+catch {destroy .b}
+toplevel .b
+wm geom .b +0+0
+update idletasks
+
+proc setup {} {
+    catch {destroy .b.f}
+    catch {font delete xyz}
+    label .b.f 
+    pack .b.f
+    update
+}
+
+label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Helvetica -12 bold"
+pack .b.l
+canvas .b.c -closeenough 0 
+.b.c create text 0 0 -tags text -anchor nw -just left -font "Helvetica -12 bold"
+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 $tcl_platform(platform) {
+    unix	{set fixed "fixed"}
+    windows	{set fixed "courier 12"}
+    macintosh	{set fixed "monaco 9"}
+}
+set times [font actual {times 0} -family]
+
+test font-1.1 {font command: general} {
+    list [catch {font} msg] $msg
+} {1 {wrong # args: should be "font option ?arg?"}}
+test font-1.2 {font command: actual: arguments} {
+    list [catch {font actual xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-1.3 {font command: actual: arguments} {
+    list [catch {font actual} msg] $msg
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+test font-1.4 {font command: actual: arguments} {
+    list [catch {font actual xyz abc def} msg] $msg
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+test font-1.5 {font command: actual: arguments} {
+    list [catch {font actual {}} msg] $msg
+} {1 {font "" doesn't exist}}
+test font-1.6 {font command: actual: displayof specified, so skip to next} {
+    catch {font actual xyz -displayof . -size}
+} {0}
+test font-1.7 {font command: actual: displayof specified, so skip to next} {
+    lindex [font actual xyz -displayof .] 0
+} {-family}
+test font-1.8 {font command: actual} {unix || mac} {
+    string tolower [font actual {-family times} -family]
+} {times}
+test font-1.9 {font command: actual} {pcOnly} {
+    font actual {-family times} -family
+} {Times New Roman}
+test font-1.10 {font command: actual} {
+    lindex [font actual {-family times}] 0
+} {-family}
+test font-1.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-2.1 {font command: configure} {
+    list [catch {font configure} msg] $msg
+} {1 {wrong # args: should be "font configure fontname ?options?"}}
+test font-2.2 {font command: configure: non-existent font} {
+    list [catch {font configure xyz} msg] $msg
+} {1 {named font "xyz" doesn't exist}}
+test font-2.3 {font command: configure: "deleted" font} {
+    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-2.4 {font command: configure: get all options} {
+    setup
+    font create xyz -family xyz
+    lindex [font configure xyz] 1
+} xyz
+test font-2.5 {font command: configure: get one option} {
+    setup
+    font create xyz -family xyz
+    font configure xyz -family
+} xyz
+test font-2.6 {font command: configure: update existing font} {
+    setup
+    font create xyz
+    font configure xyz -family xyz
+    update
+    font configure xyz -family
+} xyz
+test font-2.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-3.1 {font command: create: make up name} {
+    font delete [font create]
+    font delete [font create -family xyz]
+} {}
+test font-3.2 {font command: create: already exists} {
+    setup
+    font create xyz
+    list [catch {font create xyz} msg] $msg
+} {1 {font "xyz" already exists}}
+test font-3.3 {font command: create: error recreating "deleted" font} {
+    setup
+    font create xyz
+    .b.f configure -font xyz
+    font delete xyz
+    list [catch {font create xyz -xyz times} msg] $msg
+} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+test font-3.4 {font command: create: recreate "deleted" font} {
+    setup
+    font create xyz
+    .b.f configure -font xyz
+    font delete xyz
+    font actual xyz
+    font create xyz -family times
+    update
+    font configure xyz -family
+} {times}
+test font-3.5 {font command: create: bad option creating new font} {
+    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-3.6 {font command: create: totally new font} {
+    setup
+    font create xyz -family xyz
+    font configure xyz -family
+} {xyz}
+
+test font-4.1 {font command: delete: arguments} {
+    list [catch {font delete} msg] $msg
+} {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
+test font-4.2 {font command: delete: loop test} {
+    font create a -underline 1
+    font create b -underline 1
+    font create c -underline 1
+    font delete a b c
+    list [font actual a -underline] [font actual b -underline] [font actual c -underline]
+} {0 0 0}
+test font-4.3 {font command: delete: non-existent} {
+    setup
+    list [catch {font delete xyz} msg] $msg
+} {1 {named font "xyz" doesn't exist}}
+test font-4.4 {font command: delete: mark for later deletion} {
+    setup
+    font create xyz
+    .b.f configure -font xyz
+    font delete xyz
+    font actual xyz
+    list [catch {font configure xyz} msg] $msg
+} {1 {named font "xyz" doesn't exist}}
+test font-4.5 {font command: delete: actually delete} {
+    setup
+    font create xyz -underline 1
+    font delete xyz
+    font actual xyz -underline
+} {0}
+
+test font-5.1 {font command: families: arguments} {
+    list [catch {font families -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-5.2 {font command: families: arguments} {
+    list [catch {font families xyz} msg] $msg
+} {1 {wrong # args: should be "font families ?-displayof window?"}}
+test font-5.3 {font command: families} {
+    font families
+    set x {}
+} {}
+
+test font-6.1 {font command: measure: arguments} {
+    list [catch {font measure xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-6.2 {font command: measure: arguments} {
+    list [catch {font measure} msg] $msg
+} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
+test font-6.3 {font command: measure: arguments} {
+    list [catch {font measure xyz abc def} msg] $msg
+} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
+test font-6.4 {font command: measure: arguments} {
+    list [catch {font measure {} abc} msg] $msg
+} {1 {font "" doesn't exist}}
+test font-6.5 {font command: measure} {
+    expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
+} {1}
+
+test font-7.1 {font command: metrics: arguments} {
+    list [catch {font metrics xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-7.2 {font command: metrics: arguments} {
+    list [catch {font metrics} msg] $msg
+} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
+test font-7.3 {font command: metrics: get all metrics} {
+    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-7.4 {font command: metrics: get ascent} {
+    catch {expr [font metrics $fixed -ascent]}
+} {0}
+test font-7.5 {font command: metrics: get descent} {
+    catch {expr [font metrics {-family xyz} -descent]}
+} {0}
+test font-7.6 {font command: metrics: get linespace} {
+    catch {expr [font metrics {-family fixed} -linespace]}
+} {0}
+test font-7.7 {font command: metrics: get fixed} {
+    catch {expr [font metrics {-family fixed} -fixed]}
+} {0}
+test font-7.8 {font command: metrics: get ascent} {
+    catch {expr [font metrics {-family xyz} -ascent]}
+} {0}
+test font-7.9 {font command: metrics: get descent} {
+    catch {expr [font metrics {-family xyz} -descent]}
+} {0}
+test font-7.10 {font command: metrics: get linespace} {
+    catch {expr [font metrics {-family fixed} -linespace]}
+} {0}
+test font-7.11 {font command: metrics: get fixed} {
+    catch {expr [font metrics {-family fixed} -fixed]}
+} {0}
+test font-7.12 {font command: metrics: bad metric} {
+    list [catch {font metrics {-family fixed} -xyz} msg] $msg
+} {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}
+
+test font-8.1 {font command: names: arguments} {
+    list [catch {font names xyz} msg] $msg
+} {1 {wrong # args: should be "font names"}}
+test font-8.2 {font command: names} {
+    setup
+    font create xyz
+    font create abc
+    set x [lsort [font names]]
+    font delete abc
+    font delete xyz
+    set x
+} {abc xyz}
+test font-8.3 {font command: names} {
+    setup
+    font create xyz
+    font create abc
+    set x [lsort [font names]]
+    .b.f config -font xyz
+    font delete xyz
+    lappend x [font names]
+    font delete abc
+    set x
+} {abc xyz abc}
+
+test font-9.1 {font command: unknown option} {
+    list [catch {font xyz} msg] $msg
+} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
+
+test font-10.1 {UpdateDependantFonts procedure: no users} {
+    setup
+    font create xyz
+    font configure xyz -family times
+} {}
+test font-10.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-11.1 {Tk_GetFont procedure: bump ref count} {
+    setup
+    .b.f config -font {-family fixed}
+    lindex [font actual {-family fixed}] 0
+} {-family}
+test font-11.2 {Tk_GetFont procedure: bump ref count of named font, too} {
+    setup
+    font create xyz
+    .b.f config -font xyz
+    lindex [font actual xyz] 0
+} {-family}
+test font-11.3 {Tk_GetFont procedure: get named font} {
+    setup
+    font create xyz
+    .b.f config -font xyz
+} {}
+test font-11.4 {Tk_GetFont procedure: get native font} {unixOnly} {
+    setup
+    .b.f config -font fixed
+} {}
+test font-11.5 {Tk_GetFont procedure: get native font} {pcOnly} {
+    setup
+    .b.f config -font oemfixed
+} {}
+test font-11.6 {Tk_GetFont procedure: get native font} {macOnly} {
+    setup
+    .b.f config -font application
+} {}
+test font-11.7 {Tk_GetFont procedure: get attribute font} {
+    list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
+} {1 {expected integer but got "yyy"}}
+test font-11.8 {Tk_GetFont procedure: get attribute font} {
+    lindex [font actual {plan 9}] 0
+} {-family}
+test font-11.9 {Tk_GetFont procedure: no match} {
+    list [catch {font actual {}} msg] $msg
+} {1 {font "" doesn't exist}}
+
+test font-12.1 {Tk_NameOfFont procedure} {
+    setup
+    .b.f config -font {-family fixed}
+    .b.f cget -font
+} {-family fixed}
+
+test font-13.1 {Tk_FreeFont procedure: one ref} {
+    setup
+    .b.f config -font {-family fixed}
+    destroy .b.f
+} {}
+test font-13.2 {Tk_FreeFont procedure: multiple ref} {
+    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-13.3 {Tk_FreeFont procedure: named font} {
+    setup
+    font create xyz
+    .b.f config -font xyz
+    destroy .b.f
+    font names
+} {xyz}
+test font-13.4 {Tk_FreeFont procedure: named font} {
+    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-13.5 {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-14.1 {Tk_FontId} {
+    .b.f config -font "times 20"
+    update
+} {}
+
+test font-15.1 {Tk_FontMetrics 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 -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-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
+    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-16.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+    psfontname "arial 10"
+} {Helvetica}
+test font-16.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+    psfontname "{times new roman} 10"
+} {Times-Roman}
+test font-16.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+    psfontname "{courier new} 10"
+} {Courier}
+test font-16.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
+    psfontname "geneva 10"
+} {Helvetica}
+test font-16.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
+    psfontname "{new york} 10"
+} {Times-Roman}
+test font-16.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
+    psfontname "monaco 10"
+} {Courier}
+test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+    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-16.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+    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}
+} {
+    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
+	set family [lindex $p 0]
+	set x {}
+	set i 1
+	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]
+		}
+		incr i
+	    }
+	}
+        incr i
+	set x
+    } [lrange $p 1 end]
+}
+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}
+} {
+    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
+	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]
+}
+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-16.$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]
+}
+
+test font-17.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-18.1 {Tk_ComputeTextLayout: empty string} {
+    .b.l config -text ""
+} {}
+test font-18.2 {Tk_ComputeTextLayout: simple string} {
+    .b.l config -text "000"
+    getsize
+} "[expr $ax*3] $ay"
+test font-18.3 {Tk_ComputeTextLayout: find special chars} {
+    .b.l config -text "000\n000"
+    getsize
+} "[expr $ax*3] [expr $ay*2]"
+test font-18.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
+    .b.l config -text "000\n000"
+    getsize
+} "[expr $ax*3] [expr $ay*2]"
+test font-18.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-18.6 {Tk_ComputeTextLayout: normal ended on special char} {
+    .b.l config -text "000\n000"
+} {}
+test font-18.7 {Tk_ComputeTextLayout: special char was \n} {
+    .b.l config -text "000\n0000"
+    getsize
+} "[expr $ax*4] [expr $ay*2]"
+test font-18.8 {Tk_ComputeTextLayout: special char was \t} {
+    .b.l config -text "000\t00"
+    getsize
+} "[expr $ax*10] $ay"
+test font-18.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-18.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-18.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-18.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-18.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-18.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-18.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-19.1 {Tk_FreeTextLayout procedure} {
+    setup
+    .b.f config -text foo
+    .b.f config -text boo
+} {}
+    
+test font-20.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
+    .b.f config -text foo
+} {}
+test font-20.2 {Tk_DrawTextLayout procedure: multiple chunks} {
+    csetup "000\t00\n000"
+} {}
+test font-20.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-20.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
+    .b.c select from text 3
+    .b.c select to text 5
+} {}
+test font-20.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
+    .b.c select from text 2
+    .b.c select to text 2
+} {}
+test font-20.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
+    .b.c select from text 4
+    .b.c select to text 4
+} {}
+
+test font-21.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
+    .b.f config -text "foo" -under -1
+} {}
+test font-21.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
+    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
+} {}
+test font-21.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-22.1 {Tk_PointToChar procedure: above all lines} {
+    csetup "000"
+    .b.c index text @-1,0
+} {0}
+test font-22.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-22.3 {Tk_PointToChar procedure: loop test} {
+    csetup "000\n000\n000\n000"
+    .b.c index text @10000,0
+} {3}
+test font-22.4 {Tk_PointToChar procedure: intersect line} {
+    csetup "000\n000\n000"
+    .b.c index text @0,$ay
+} {4}
+test font-22.5 {Tk_PointToChar procedure: to the left of all chunks} {
+    .b.c index text @-100,$ay
+} {4}
+test font-22.6 {Tk_PointToChar procedure: past any possible chunk} {
+    .b.c index text @100000,$ay
+} {7}
+test font-22.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-22.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-22.9 {Tk_PointToChar procedure: in special chunk} {
+    csetup "000\n000\t000\t000\n000"
+    .b.c index text @[expr $ax*6],$ay
+} {7}
+test font-22.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-22.11 {Tk_PointToChar procedure: below all chunks} {
+    csetup "000 0000000"
+    .b.c index text @0,1000000
+} {11}
+    
+test font-23.1 {Tk_CharBBox procedure: index < 0} {
+    .b.f config -text "000" -underline -1
+} {}
+test font-23.2 {Tk_CharBBox procedure: loop} {
+    .b.f config -text "000\t000\t000\t000" -underline 9
+} {}
+test font-23.3 {Tk_CharBBox procedure: special char} {
+    .b.f config -text "000\t000\t000" -underline 7
+} {}
+test font-23.4 {Tk_CharBBox procedure: normal char} {
+    .b.f config -text "000" -underline 1
+} {}
+test font-23.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-23.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-24.1 {Tk_TextLayoutToPoint 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-24.2 {Tk_TextLayoutToPoint 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-24.3 {Tk_TextLayoutToPoint 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-24.4 {Tk_TextLayoutToPoint 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-24.5 {Tk_TextLayoutToPoint 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-24.6 {Tk_TextLayoutToPoint 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-24.7 {Tk_TextLayoutToPoint 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-24.8 {Tk_TextLayoutToPoint 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-24.9 {Tk_TextLayoutToPoint 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-24.10 {Tk_TextLayoutToPoint 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-24.11 {Tk_TextLayoutToPoint 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-24.12 {Tk_TextLayoutToPoint 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-24.13 {Tk_TextLayoutToPoint 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-25.1 {Tk_TextLayoutToArea procedure: loop once} {
+    csetup "000\n000\n000"
+    .b.c find overlapping 0 0 0 0
+} [.b.c find withtag text]
+test font-25.2 {Tk_TextLayoutToArea 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-25.3 {Tk_TextLayoutToArea procedure: loop to end} {
+    csetup "0\n000"
+    .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
+} {}
+test font-25.4 {Tk_TextLayoutToArea 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-25.5 {Tk_TextLayoutToArea procedure: ignore newlines} {
+    csetup "000\n0\n000"
+    .b.c find overlapping $ax $ay $ax $ay
+} {}
+test font-25.6 {Tk_TextLayoutToArea 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-26.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 + 213}]
+} {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)
+(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+(end)
+}
+
+test font-27.1 {Tk_TextWidth procedure} {
+    font measure [.b.l cget -font] "000"
+} [expr $ax*3]
+
+test font-28.1 {SetupFontMetrics procedure} {
+    setup
+    .b.f config -font $fixed
+} {}
+
+test font-29.1 {TkInitFontAttributes procedure} {
+    setup
+    font create xyz
+    font config xyz
+} {-family {} -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
+
+test font-30.1 {ConfigAttributes procedure: arguments} {
+    setup
+    list [catch {font create xyz -family} msg] $msg
+} {1 {missing value for "-family" option}}
+test font-30.2 {ConfigAttributes procedure: arguments} {
+    setup
+    list [catch {font create xyz -xyz xyz} msg] $msg
+} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+set i 3
+foreach p {
+    {family xyz times}
+    {size 20 40}
+    {weight normal bold}
+    {slant roman italic}
+    {underline 0 1}
+    {overstrike 0 1}
+} {
+    set opt [lindex $p 0]
+    test font-30.$i "ConfigAttributes procedure: $opt" {
+	setup
+	set x {}
+	font create xyz -$opt [lindex $p 1]
+	lappend x [font config xyz -$opt]
+	font config xyz -$opt [lindex $p 2]
+	lappend x [font config xyz -$opt]
+    } [lrange $p 1 2]
+    incr i
+}
+foreach p {
+    {size	xyz {1 {expected integer but got "xyz"}}}
+    {weight	xyz {1 {bad -weight value "xyz": must be normal, bold}}}
+    {slant	xyz {1 {bad -slant value "xyz": must be roman, italic}}}
+    {underline	xyz {1 {expected boolean value but got "xyz"}}}
+    {overstrike	xyz {1 {expected boolean value but got "xyz"}}}
+} {
+    test font-30.$i "ConfigAttributes procedure: [lindex $p 0]" {
+	setup
+	list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
+    } [lindex $p 2]
+    incr i
+}
+
+test font-31.1 {GetAttributeInfo procedure: error} {
+    list [catch {font actual xyz -style} msg] $msg
+} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+test font-31.2 {GetAttributeInfo procedure: all attributes} {
+    setup
+    font create xyz -family xyz
+    font config xyz
+} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
+set i 3
+foreach p {
+    {family	xyz	xyz}
+    {size	20	20}
+    {weight	normal	normal}
+    {slant	italic	italic}
+    {underline	yes	1}
+    {overstrike	false	0}
+} {
+    test font-31.$i "GetAttributeInfo procedure: [lindex $p 0]" {
+	setup
+	font create xyz -[lindex $p 0] [lindex $p 1]
+	font config xyz -[lindex $p 0]
+    } [lindex $p 2]
+    incr i
+}
+
+# In tests below, one field is set to "xyz" so that font name doesn't
+# look like a native X font, so that ParseFontName or TkParseXLFD will
+# be called.
+
+setup
+
+test font-32.1 {ParseFontName procedure: begins with -} {
+    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-32.2 {ParseFontName procedure: begins with -*} {
+    lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-32.3 {ParseFontName procedure: begins with -, doesn't look like list} {
+    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-32.4 {ParseFontName procedure: begins with -, looks like list} {
+    lindex [font actual {-family times}] 1
+} $times
+test font-32.5 {ParseFontName procedure: begins with *} {
+    lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+test font-32.6 {ParseFontName procedure: begins with *} {
+    font actual *-times-xyz -family
+} $times
+test font-32.7 {ParseFontName procedure: arguments} {
+    list [catch {font actual {}} msg] $msg
+} {1 {font "" doesn't exist}}
+test font-32.8 {ParseFontName procedure: arguments} {
+    list [catch {font actual {times 20 xyz xyz}} msg] $msg
+} {1 {unknown font style "xyz"}}
+test font-32.9 {ParseFontName procedure: arguments} {
+    list [catch {font actual {times xyz xyz}} msg] $msg
+} {1 {expected integer but got "xyz"}}
+test font-32.10 {ParseFontName 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-32.11 {ParseFontName 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-32.12 {ParseFontName procedure: stylelist error} {
+    list [catch {font actual {times 12 bold xyz}} msg] $msg
+} {1 {unknown font style "xyz"}}
+
+test font-33.1 {TkParseXLFD procedure: initial dash} {
+    font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
+} $times
+test font-33.2 {TkParseXLFD procedure: no initial dash} {
+    font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
+} $times
+test font-33.3 {TkParseXLFD procedure: not enough fields} {
+    font actual -xyz-times-*-*-* -family
+} $times
+test font-33.4 {TkParseXLFD procedure: all fields unspecified} {
+    lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
+} {-family}
+test font-33.5 {TkParseXLFD 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-33.6 {TkParseXLFD procedure: arguments} {
+    # XLFD with bad pointsize: fallback to some system font.
+    font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
+    set x {}
+} {}
+test font-33.7 {TkParseXLFD procedure: arguments} {
+    # XLFD with bad pixelsize: fallback to some system font.
+    font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
+    set x {}
+} {}
+test font-33.8 {TkParseXLFD procedure: pixelsize specified} {
+    font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
+    set x {}
+} {}
+test font-33.9 {TkParseXLFD procedure: weird pixelsize specified} {
+    font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
+    set x {}
+} {}
+test font-33.10 {TkParseXLFD procedure: pointsize specified} {
+    font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
+    set x {}
+} {}
+test font-33.11 {TkParseXLFD procedure: weird pointsize specified} {
+    font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
+    set x {}
+} {}
+
+test font-34.1 {FieldSpecified procedure: specified vs. non-specified} {
+    font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
+    font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
+    font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
+    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
+} $times
+
+test font-35.1 {NewChunk procedure: test realloc} {
+    .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
+} {}
+
+destroy .b
+return