font.test

linux系统下的音频通信

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