font.test

linux系统下的音频通信

# 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 "Courier -12"
pack .b.l
canvas .b.c -closeenough 0 
.b.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
pack .b.c
update

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

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

setup

case $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