* Merged 8.1 branch into the main trunk

1 files changed, 585 insertions, 288 deletions

diff --git a/tests/font.test b/tests/font.test
index 909085b..264dee5 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -1,16 +1,21 @@
 # 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.
+# standard white-box fashion for Tcl tests.
 #
-# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1996-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: font.test,v 1.3 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: font.test,v 1.4 1999/04/16 01:51:37 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
-if {[string compare test [info procs test]] != 0} {
-    source defs
+if {[info commands testfont] != "testfont"} {
+    puts "testfont command not available; skipping tests"
+    ::tcltest::cleanupTests
+    return
 }
 
 catch {destroy .b}
@@ -20,7 +25,7 @@ update idletasks
 
 proc setup {} {
     catch {destroy .b.f}
-    catch {font delete xyz}
+    catch {eval font delete [font names]}
     label .b.f 
     pack .b.f
     update
@@ -56,243 +61,357 @@ case $tcl_platform(platform) {
 }
 set times [font actual {times 0} -family]
 
-test font-1.1 {font command: general} {
+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-1.2 {font command: actual: arguments} {
+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-1.3 {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?"}}
-test font-1.4 {font command: actual: arguments} {
+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?"}}
-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} {
+test font-4.4 {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} {
+test font-4.5 {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} {
+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?"}}
+test font-4.7 {font command: actual: arguments} {
+    # (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} {macOrUnix} {
+    # (objc > 3) so objPtr = objv[3 + skip]
     string tolower [font actual {-family times} -family]
 } {times}
-test font-1.9 {font command: actual} {pcOnly} {
+test font-4.10 {font command: actual} {pcOnly} {
+    # (objc > 3) so objPtr = objv[3 + skip]
     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} {
+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-2.1 {font command: configure} {
+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-2.2 {font command: configure: non-existent font} {
+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-2.3 {font command: configure: "deleted" font} {
+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-2.4 {font command: configure: get all options} {
+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-2.5 {font command: configure: get one option} {
+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-2.6 {font command: configure: update existing font} {
+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-2.7 {font command: configure: bad option} {
+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-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} {
+test font-6.1 {font command: create: make up name} {
+    # (objc < 3) so name = NULL
     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} {
+    font create
+    font names
+} {font1}
+test font-6.2 {font command: create: name specified} {
+    # not (objc < 3)
     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} {
+    font names
+} {xyz}
+test font-6.3 {font command: create: name not really specified} {
+    # (name[0] == '-') so name = NULL
     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} {
+    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-3.6 {font command: create: totally new font} {
+test font-6.6 {font command: create: bad option creating new font} {
+    # name was not specified so skip = 2 
     setup
-    font create xyz -family xyz
-    font configure xyz -family
-} {xyz}
+    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-4.1 {font command: delete: arguments} {
+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-4.2 {font command: delete: loop test} {
+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 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} {
+    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-4.4 {font command: delete: mark for later deletion} {
+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
-} {1 {named font "xyz" doesn't exist}}
-test font-4.5 {font command: delete: actually delete} {
+    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
-    font actual xyz -underline
-} {0}
+    catch {font config xyz}
+} {1}
+setup
 
-test font-5.1 {font command: families: arguments} {
+test font-8.1 {font command: families: arguments} {
+    # (skip < 0)
     list [catch {font families -displayof} msg] $msg
 } {1 {value for "-displayof" missing}}
-test font-5.2 {font command: families: arguments} {
+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-5.3 {font command: families} {
-    font families
-    set x {}
-} {}
+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-6.1 {font command: measure: arguments} {
+test font-9.1 {font command: measure: arguments} {
+    # (skip < 0)
     list [catch {font measure xyz -displayof} msg] $msg
 } {1 {value for "-displayof" missing}}
-test font-6.2 {font command: measure: arguments} {
+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-6.3 {font command: measure: arguments} {
+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-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} {
+test font-9.4 {font command: measure: arguments} {
+    # (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-7.1 {font command: metrics: arguments} {
+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-7.2 {font command: metrics: arguments} {
+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-7.3 {font command: metrics: get all metrics} {
+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} {
+    # (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-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
+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-8.1 {font command: names: arguments} {
+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-8.2 {font command: 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
-    set x [lsort [font names]]
-    font delete abc
-    font delete xyz
-    set x
-} {abc xyz}
-test font-8.3 {font command: names} {
+    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
-    set x [lsort [font names]]
+    lappend x [lsort [font names]]
     .b.f config -font xyz
     font delete xyz
     lappend x [font names]
-    font delete abc
-    set x
-} {abc xyz abc}
+} {{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} {
+test font-12.1 {UpdateDependantFonts procedure: no users} {
+    # (nfPtr->refCount == 0)
     setup
     font create xyz
     font configure xyz -family times
 } {}
-test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
+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
@@ -306,56 +425,155 @@ test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
     expr {$a1==$b1 && $a2==$b2}
 } {1}
 
-test font-11.1 {Tk_GetFont procedure: bump ref count} {
+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} {
+    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} {
+    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} {
+    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-11.2 {Tk_GetFont procedure: bump ref count of named font, too} {
+test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
+    # (namedHashPtr != NULL) 
     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} {
+    font create xyz 
+    .b.f config -font xyz 
+} {}
+test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
+    # not (namedHashPtr != NULL)
     setup
-    font create xyz
-    .b.f config -font xyz
+    .b.f config -font {times 20}
 } {}
-test font-11.4 {Tk_GetFont procedure: get native font} {unixOnly} {
+test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} {
+    # not (fontPtr == NULL) 
     setup
     .b.f config -font fixed
 } {}
-test font-11.5 {Tk_GetFont procedure: get native font} {pcOnly} {
+test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
+    # not (fontPtr == NULL) 
     setup
     .b.f config -font oemfixed
 } {}
-test font-11.6 {Tk_GetFont procedure: get native font} {macOnly} {
+test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
+    # not (fontPtr == NULL) 
     setup
     .b.f config -font application
 } {}
-test font-11.7 {Tk_GetFont procedure: get attribute font} {
+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-11.8 {Tk_GetFont procedure: get attribute font} {
+test font-15.11 {Tk_AllocFontFromObj procedure: no match} {
+    # (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-11.9 {Tk_GetFont procedure: no match} {
-    list [catch {font actual {}} msg] $msg
-} {1 {font "" doesn't exist}}
+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-12.1 {Tk_NameOfFont procedure} {
+test font-16.1 {Tk_NameOfFont procedure} {
     setup
-    .b.f config -font {-family fixed}
+    .b.f config -font -family\ fixed
     .b.f cget -font
 } {-family fixed}
 
-test font-13.1 {Tk_FreeFont procedure: one ref} {
+test font-17.1 {Tk_FreeFontFromObj - reference counts} {
+    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-13.2 {Tk_FreeFont procedure: multiple ref} {
+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}
@@ -364,14 +582,16 @@ test font-13.2 {Tk_FreeFont procedure: multiple ref} {
     destroy .b.b
     set x
 } {-family fixed}
-test font-13.3 {Tk_FreeFont procedure: named font} {
+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-13.4 {Tk_FreeFont procedure: named font} {
+test font-17.5 {Tk_FreeFont procedure: named font} {
+    # not (fontPtr->refCount == 0) 
     setup
     font create xyz -underline 1
     .b.f config -font xyz
@@ -380,9 +600,9 @@ test font-13.4 {Tk_FreeFont procedure: named font} {
     destroy .b.f
     list [font actual xyz -underline] $x
 } {0 1}
-test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
+test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
     setup
-    font create xyz
+    font create xyz 
     .b.f config -font xyz
     button .b.b -font xyz
     font delete xyz
@@ -391,12 +611,32 @@ test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
     list [lindex [font actual xyz] 0] [lindex $x 0]
 } {-family -family}
 
-test font-14.1 {Tk_FontId} {
+test font-18.1 {FreeFontObjProc} {
+    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-15.1 {Tk_FontMetrics procedure} {
+test font-20.1 {Tk_GetFontMetrics procedure} {
     button .b.w1 -text abc
     entry .b.w2 -text abcd
     update
@@ -414,7 +654,7 @@ proc psfontname {name} {
     set start [string first "gsave" $post]
     return [string range $post [expr $start+7] end]
 }
-test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
+test font-21.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"
@@ -422,25 +662,25 @@ test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
 	set x {AvantGarde-Book}
     }
 } {AvantGarde-Book}
-test font-16.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
     psfontname "arial 10"
 } {Helvetica}
-test font-16.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
     psfontname "{times new roman} 10"
 } {Times-Roman}
-test font-16.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
     psfontname "{courier new} 10"
 } {Courier}
-test font-16.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
     psfontname "geneva 10"
 } {Helvetica}
-test font-16.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
     psfontname "{new york} 10"
 } {Times-Roman}
-test font-16.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
     psfontname "monaco 10"
 } {Courier}
-test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
     set x [font actual {{lucida bright} 10} -family]
     if {[string match lucida*bright $x]} {
 	psfontname "{lucida bright} 10"
@@ -448,7 +688,7 @@ test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
 	set x {LucidaBright}
     }
 } {LucidaBright}
-test font-16.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
     psfontname "{new century schoolbook} 10"
 } {NewCenturySchlbk-Roman}
 set i 10
@@ -464,7 +704,7 @@ foreach p {
     {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
     {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
 } {
-    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
+    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
 	set family [lindex $p 0]
 	set x {}
 	set i 1
@@ -490,7 +730,7 @@ foreach p {
     {"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} {
+    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
 	set family [lindex $p 0]
 	set x {}
 	foreach slant {roman italic} {
@@ -511,7 +751,7 @@ foreach p {
     {"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} {
+    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
 	set family [lindex $p 0]
 	set x {}
 	foreach slant {roman italic} {
@@ -524,7 +764,11 @@ foreach p {
     } [lrange $p 1 end]
 }
 
-test font-17.1 {Tk_UnderlineChars procedure} {
+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
@@ -533,39 +777,39 @@ test font-17.1 {Tk_UnderlineChars procedure} {
 } {}
 
 setup
-test font-18.1 {Tk_ComputeTextLayout: empty string} {
+test font-24.1 {Tk_ComputeTextLayout: empty string} {
     .b.l config -text ""
 } {}
-test font-18.2 {Tk_ComputeTextLayout: simple string} {
+test font-24.2 {Tk_ComputeTextLayout: simple string} {
     .b.l config -text "000"
     getsize
 } "[expr $ax*3] $ay"
-test font-18.3 {Tk_ComputeTextLayout: find special chars} {
+test font-24.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} {
+test font-24.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} {
+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-18.6 {Tk_ComputeTextLayout: normal ended on special char} {
+test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
     .b.l config -text "000\n000"
 } {}
-test font-18.7 {Tk_ComputeTextLayout: special char was \n} {
+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-18.8 {Tk_ComputeTextLayout: special char was \t} {
+test font-24.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} {
+test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
     set x {}
     .b.l config -text "000\t000"
     lappend x [getsize]
@@ -574,7 +818,7 @@ test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} {
     .b.l config -wrap 0
     set x
 } "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
-test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
+test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
     set x {}
     .b.l config -text "000\t"
     lappend x [getsize]
@@ -583,7 +827,7 @@ test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
     .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} {
+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]
@@ -592,7 +836,7 @@ test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
     .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} {
+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]
@@ -601,14 +845,14 @@ test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
     .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} {
+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-18.14 {Tk_ComputeTextLayout: text ended with \n} {
+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-18.15 {Tk_ComputeTextLayout: justification} {
+test font-24.15 {Tk_ComputeTextLayout: justification} {
     csetup "000\n00000"
     set x {}
     .b.c itemconfig text -just left
@@ -621,52 +865,52 @@ test font-18.15 {Tk_ComputeTextLayout: justification} {
     set x
 } {2 1 0}
 
-test font-19.1 {Tk_FreeTextLayout procedure} {
+test font-25.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} {
+test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
     .b.f config -text foo
 } {}
-test font-20.2 {Tk_DrawTextLayout procedure: multiple chunks} {
+test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
     csetup "000\t00\n000"
 } {}
-test font-20.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
+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-20.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
+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-20.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
+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-20.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
+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-21.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
+test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
     .b.f config -text "foo" -under -1
 } {}
-test font-21.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
+test font-27.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} {
+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-22.1 {Tk_PointToChar procedure: above all lines} {
+test font-28.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} {
+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
@@ -678,103 +922,103 @@ test font-22.2 {Tk_PointToChar procedure: no chars} {
     csetup ""
     .b.c index text @100,100
 } {0}
-test font-22.3 {Tk_PointToChar procedure: loop test} {
+test font-28.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} {
+test font-28.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} {
+test font-28.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} {
+test font-28.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} {
+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-22.8 {Tk_PointToChar procedure: which chunk on this line} {
+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-22.9 {Tk_PointToChar procedure: in special chunk} {
+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-22.10 {Tk_PointToChar procedure: past all chars in chunk} {
+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-22.11 {Tk_PointToChar procedure: below all chunks} {
+test font-28.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} {
+test font-29.1 {Tk_CharBBox procedure: index < 0} {
     .b.f config -text "000" -underline -1
 } {}
-test font-23.2 {Tk_CharBBox procedure: loop} {
+test font-29.2 {Tk_CharBBox procedure: loop} {
     .b.f config -text "000\t000\t000\t000" -underline 9
 } {}
-test font-23.3 {Tk_CharBBox procedure: special char} {
+test font-29.3 {Tk_CharBBox procedure: special char} {
     .b.f config -text "000\t000\t000" -underline 7
 } {}
-test font-23.4 {Tk_CharBBox procedure: normal char} {
+test font-29.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} {
+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-23.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
+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-24.1 {Tk_TextLayoutToPoint procedure: loop once} {
+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-24.2 {Tk_TextLayoutToPoint procedure: loop multiple} {
+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-24.3 {Tk_TextLayoutToPoint procedure: loop to end} {
+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-24.4 {Tk_TextLayoutToPoint procedure: hit a special char (tab)} {
+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-24.5 {Tk_TextLayoutToPoint procedure: ignore newline} {
+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-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
+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 {}
@@ -784,42 +1028,42 @@ test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
     set x
 } {}
 .b.c itemconfig text -justify center
-test font-24.7 {Tk_TextLayoutToPoint procedure: on left side} {
+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-24.8 {Tk_TextLayoutToPoint procedure: on right side} {
+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-24.9 {Tk_TextLayoutToPoint procedure: inside line} {
+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-24.10 {Tk_TextLayoutToPoint procedure: above line} {
+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-24.11 {Tk_TextLayoutToPoint procedure: below line} {
+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-24.12 {Tk_TextLayoutToPoint procedure: in line} {
+test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
     csetup "0\n000"
     set x {}
     event generate .b.c <Leave>
@@ -827,7 +1071,7 @@ test font-24.12 {Tk_TextLayoutToPoint procedure: in line} {
     set x
 } {3}
 .b.c itemconfig text -justify left
-test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
+test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
     csetup "000"
     set x {}
     event generate .b.c <Leave>
@@ -835,27 +1079,27 @@ test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
     set x
 } {1}
 
-test font-25.1 {Tk_TextLayoutToArea procedure: loop once} {
+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-25.2 {Tk_TextLayoutToArea procedure: loop multiple} {
+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-25.3 {Tk_TextLayoutToArea procedure: loop to end} {
+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-25.4 {Tk_TextLayoutToArea procedure: hit a special char (tab)} {
+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-25.5 {Tk_TextLayoutToArea procedure: ignore newlines} {
+test font-31.5 {Tk_IntersectTextLayout 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} {
+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]
@@ -863,7 +1107,7 @@ test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} {
     set x
 } {}
 
-test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
+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.
     
@@ -910,29 +1154,19 @@ test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
 (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-33.1 {Tk_TextWidth procedure} {
 } {}
 
-test font-29.1 {TkInitFontAttributes procedure} {
+test font-33.2 {ConfigAttributesObj procedure: arguments} {
+    # (Tcl_GetIndexFromObj() != TCL_OK)
     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} {
+    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} {
+    # (objc & 1)
     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}}
+} {1 {value for "-family" option missing}}
 set i 3
 foreach p {
     {family xyz times}
@@ -943,7 +1177,7 @@ foreach p {
     {overstrike 0 1}
 } {
     set opt [lindex $p 0]
-    test font-30.$i "ConfigAttributes procedure: $opt" {
+    test font-34.$i "ConfigAttributesObj procedure: $opt" {
 	setup
 	set x {}
 	font create xyz -$opt [lindex $p 1]
@@ -955,27 +1189,37 @@ foreach p {
 }
 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}}}
+    {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"}}}
 } {
-    test font-30.$i "ConfigAttributes procedure: [lindex $p 0]" {
+    test font-34.$i "ConfigAttributesObj 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} {
+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 3
+set i 4
 foreach p {
     {family	xyz	xyz}
     {size	20	20}
@@ -993,100 +1237,153 @@ foreach p {
 }
 
 # 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
+# look like a native X font, so that ParseFontNameObj or TkParseXLFD will
 # be called.
 
 setup
 
-test font-32.1 {ParseFontName procedure: begins with -} {
+test font-38.1 {ParseFontNameObj procedure: begins with -} {
     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
-test font-32.2 {ParseFontName procedure: begins with -*} {
+test font-38.2 {ParseFontNameObj procedure: begins with -*} {
     lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
-test font-32.3 {ParseFontName procedure: begins with -, doesn't look like list} {
+test font-38.3 {ParseFontNameObj 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} {
+test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
     lindex [font actual {-family times}] 1
 } $times
-test font-32.5 {ParseFontName procedure: begins with *} {
+test font-38.5 {ParseFontNameObj procedure: begins with *} {
     lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
-test font-32.6 {ParseFontName procedure: begins with *} {
+test font-38.6 {ParseFontNameObj procedure: begins with *} {
     font actual *-times-xyz -family
 } $times
-test font-32.7 {ParseFontName procedure: arguments} {
-    list [catch {font actual {}} msg] $msg
+test font-38.7 {ParseFontNameObj procedure: arguments} {
+    list [catch {font actual "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-38.8 {ParseFontNameObj procedure: arguments} {
+    list [catch {font actual ""} msg] $msg
 } {1 {font "" doesn't exist}}
-test font-32.8 {ParseFontName procedure: arguments} {
+test font-38.9 {ParseFontNameObj procedure: arguments} {
     list [catch {font actual {times 20 xyz xyz}} msg] $msg
 } {1 {unknown font style "xyz"}}
-test font-32.9 {ParseFontName 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-32.10 {ParseFontName procedure: stylelist loop} {macOnly} {
+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-32.11 {ParseFontName procedure: stylelist loop} {unixOrPc} {
+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-32.12 {ParseFontName procedure: stylelist error} {
+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-33.1 {TkParseXLFD procedure: initial dash} {
+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-33.2 {TkParseXLFD procedure: no initial dash} {
+test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
     font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
 } $times
-test font-33.3 {TkParseXLFD procedure: not enough fields} {
+test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
     font actual -xyz-times-*-*-* -family
 } $times
-test font-33.4 {TkParseXLFD procedure: all fields unspecified} {
+test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
     lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
 } {-family}
-test font-33.5 {TkParseXLFD procedure: all fields specified} {
+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-33.6 {TkParseXLFD procedure: arguments} {
+test font-41.1 {TkParseXLFD procedure: arguments} {
     # XLFD with bad pointsize: fallback to some system font.
     font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
     set x {}
 } {}
-test font-33.7 {TkParseXLFD procedure: arguments} {
+test font-42.1 {TkFontParseXLFD procedure: arguments} {
     # XLFD with bad pixelsize: fallback to some system font.
     font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
     set x {}
 } {}
-test font-33.8 {TkParseXLFD procedure: pixelsize specified} {
+test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
     font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
     set x {}
 } {}
-test font-33.9 {TkParseXLFD procedure: weird pixelsize specified} {
+test font-42.3 {TkFontParseXLFD 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} {
+test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
     font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
     set x {}
 } {}
-test font-33.11 {TkParseXLFD procedure: weird pointsize specified} {
+test font-42.5 {TkFontParseXLFD 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} {
+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
 
-test font-35.1 {NewChunk procedure: test realloc} {
-    .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
-} {}
+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 {TkFontGetPixels: size >= 0} {
+    font actual {times 12} -size
+} {12}
+
+test font-45.1 {TkFontGetPoints: size >= 0} {
+    font actual {times 12} -size
+} {12}
+test font-45.2 {TkFontGetPoints: size < 0} {
+    font actual {times -12} -size
+} {24}
+
+tk scaling $oldscale
+
+test font-46.1 {TkFontGetAliasList: no match} {
+    font actual {snarky 10} -family
+} [font actual {-size 10} -family]
+test font-46.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-46.3 {TkFontGetAliasList: match} {pcOnly} {
+    font actual {times 10} -family
+} {Times New Roman}
+test font-46.4 {TkFontGetAliasList: match} {unixOnly} {
+    font actual {{times new roman} 10} -family
+} [font actual {times 10} -family]
+
+setup
 
 destroy .b
+
+# cleanup
+::tcltest::cleanupTests
 return
+
+
+
+
+
+
+
+
+
+
+
+
+