summaryrefslogtreecommitdiffstats
path: root/tk8.6/tests/winFont.test
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2017-10-17 19:50:58 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2017-10-17 19:50:58 (GMT)
commit9b7a6c3507ea3383c60aaecb29f873c9b590ccca (patch)
tree82ce31ebd8f46803d969034f5aa3db8d7974493c /tk8.6/tests/winFont.test
parent87fca7325b97005eb44dcf3e198277640af66115 (diff)
downloadblt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.zip
blt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.tar.gz
blt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.tar.bz2
rm tcl/tk 8.6.7
Diffstat (limited to 'tk8.6/tests/winFont.test')
-rw-r--r--tk8.6/tests/winFont.test392
1 files changed, 0 insertions, 392 deletions
diff --git a/tk8.6/tests/winFont.test b/tk8.6/tests/winFont.test
deleted file mode 100644
index 8039426..0000000
--- a/tk8.6/tests/winFont.test
+++ /dev/null
@@ -1,392 +0,0 @@
-# This file is a Tcl script to test out the procedures in tkWinFont.c.
-# It is organized in the standard fashion for Tcl tests.
-#
-# Many of these tests are visually oriented and cannot be checked
-# programmatically (such as "does an underlined font appear to be
-# underlined?"); these tests attempt to exercise the code in question,
-# but there are no results that can be checked.
-#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-
-package require tcltest 2.2
-namespace import ::tcltest::*
-tcltest::configure {*}$argv
-tcltest::loadTestedCommands
-
-
-test winfont-1.1 {TkpGetNativeFont procedure: not native} -constraints {
- win
-} -body {
- catch {font delete xyz}
- font measure {} xyz
-} -returnCodes error -result {font "" doesn't exist}
-test winfont-1.2 {TkpGetNativeFont procedure: native} -constraints win -body {
- font measure ansifixed 0
- font measure ansi 0
- font measure device 0
- font measure oemfixed 0
- font measure systemfixed 0
- font measure system 0
- set x {}
-} -result {}
-
-
-test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} -constraints {
- win
-} -body {
- expr {[font actual {-size -10} -size] > 0}
-} -result {1}
-test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} -constraints {
- win
-} -body {
- expr {[font actual {-family Arial} -size] > 0}
-} -result {1}
-test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} -constraints {
- win
-} -body {
- font actual {-weight normal} -weight
-} -result {normal}
-test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} -constraints {
- win
-} -body {
- font actual {-weight bold} -weight
-} -result {bold}
-test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} -constraints {
- win
-} -body {
- catch {expr {[font actual {-size 10} -size]}}
-} -result 0
-test winfont-2.6 {TkpGetFontFromAttributes procedure: family} -constraints {
- win
-} -body {
- font actual {-family Arial} -family
-} -result {Arial}
-test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} -constraints {
- win
-} -setup {
- set x {}
-} -body {
- lappend x [font actual {-family "Times"} -family]
- lappend x [font actual {-family "New York"} -family]
- lappend x [font actual {-family "Times New Roman"} -family]
-} -result {{Times New Roman} {Times New Roman} {Times New Roman}}
-test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} -constraints {
- win
-} -setup {
- set x {}
-} -body {
- lappend x [font actual {-family "Courier"} -family]
- lappend x [font actual {-family "Monaco"} -family]
- lappend x [font actual {-family "Courier New"} -family]
-} -result {{Courier New} {Courier New} {Courier New}}
-test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} -constraints {
- win
-} -setup {
- set x {}
-} -body {
- lappend x [font actual {-family "Helvetica"} -family]
- lappend x [font actual {-family "Geneva"} -family]
- lappend x [font actual {-family "Arial"} -family]
-} -result {Arial Arial Arial}
-test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} -constraints {
- win
-} -body {
- # No way to get it to fail! Any font name is acceptable.
-} -result {}
-
-
-test winfont-3.1 {TkpDeleteFont procedure} -constraints win -body {
- catch {font delete xyz}
- font actual {-family xyz}
- set x {}
-} -result {}
-
-
-test winfont-4.1 {TkpGetFontFamilies procedure} -constraints win -body {
- font families
- set x {}
-} -result {}
-
-destroy .t
-toplevel .t
-wm geometry .t +0+0
-update idletasks
-label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed
-pack .t.l
-canvas .t.c -closeenough 0
-
-set courier {Courier 14}
-set cx [font measure $courier 0]
-set t [.t.c create text 0 0 -anchor nw -just left -font $courier]
-pack .t.c
-update
-
-set ax [winfo reqwidth .t.l]
-set ay [winfo reqheight .t.l]
-proc getsize {} {
- update
- return "[winfo reqwidth .t.l] [winfo reqheight .t.l]"
-}
-
-test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap 0 -text "000000"
- list [expr {[winfo reqwidth .t.l] eq 6*$ax}] \
- [expr {[winfo reqheight .t.l] eq $ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
- list [expr {[winfo reqwidth .t.l] eq 256*$ax}] \
- [expr {[winfo reqheight .t.l] eq $ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap [expr $ax*10] -text "00000000"
- list [expr {[winfo reqwidth .t.l] eq 8*$ax}] \
- [expr {[winfo reqheight .t.l] eq $ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap [expr $ax*6] -text "00000000"
- list [expr {[winfo reqwidth .t.l] eq 6*$ax}] \
- [expr {[winfo reqheight .t.l] eq 2*$ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} -constraints {
- win
-} -setup {
- destroy .t.c
-} -body {
- canvas .t.c -closeenough 0
- set t [.t.c create text 0 0 -anchor nw -just left -font $courier]
- pack .t.c
- update
-
- .t.c dchars $t 0 end
- .t.c insert $t 0 "0000"
- .t.c index $t @[expr int($cx*2.5)],1
-} -cleanup {
- destroy .t.c
-} -result {2}
-
-test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -text "000000" -wrap 1
- list [expr {[winfo reqwidth .t.l] eq $ax}] \
- [expr {[winfo reqheight .t.l] eq 6*$ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.7 {Tk_MeasureChars procedure: whole words} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap [expr $ax*8] -text "000000 0000"
- list [expr {[winfo reqwidth .t.l] eq 6*$ax}] \
- [expr {[winfo reqheight .t.l] eq 2*$ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap [expr $ax*12] -text "000000 0000000"
- list [expr {[winfo reqwidth .t.l] eq 7*$ax}] \
- [expr {[winfo reqheight .t.l] eq 2*$ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap [expr $ax*12] -text "000 00 00000"
- list [expr {[winfo reqwidth .t.l] eq 7*$ax}] \
- [expr {[winfo reqheight .t.l] eq 2*$ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} -constraints {
- win
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- set ax [winfo reqwidth .t.l]
- set ay [winfo reqheight .t.l]
-
- .t.l config -wrap [expr $ax*12] -text "0000000000000000"
- list [expr {[winfo reqwidth .t.l] eq 12*$ax}] \
- [expr {[winfo reqheight .t.l] eq 2*$ay}]
-} -cleanup {
- destroy .t.l
-} -result {1 1}
-
-test winfont-5.11 {Tk_MeasureChars procedure: check for kerning} -constraints {
- win nonPortable
-} -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
-
- set font [.t.l cget -font]
- .t.l config -font {{MS Sans Serif} 8} -text "W"
- set width [winfo reqwidth .t.l]
- .t.l config -text "XaYoYaKaWx"
- set x [lindex [getsize] 0]
- .t.l config -font $font
- expr $x < ($width*10)
-} -cleanup {
- destroy .t.l
-} -result {1}
-
-
-test winfont-6.1 {Tk_DrawChars procedure: loop test} -constraints win -setup {
- destroy .t.l
-} -body {
- label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
- -text "0" -font systemfixed
- pack .t.l
- update
- .t.l config -text "a"
- update
-} -cleanup {
- destroy .t.l
-} -result {}
-
-
-test winfont-7.1 {AllocFont procedure: use old font} -constraints win -setup {
- destroy .c
-} -setup {
- catch {font delete xyz}
-} -body {
- font create xyz
- button .c -font xyz
- font configure xyz -family times
- update
- destroy .c
- font delete xyz
-} -result {}
-test winfont-7.2 {AllocFont procedure: extract info from logfont} -constraints {
- win
-} -body {
- font actual {arial 10 bold italic underline overstrike}
-} -result {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
-test winfont-7.3 {AllocFont procedure: extract info from textmetric} -constraints {
- win
-} -body {
- font metric {arial 10 bold italic underline overstrike} -fixed
-} -result {0}
-test winfont-7.4 {AllocFont procedure: extract info from textmetric} -constraints {
- win
-} -body {
- font metric systemfixed -fixed
-} -result {1}
-
-# cleanup
-cleanupTests
-return
-
-# Local variables:
-# mode: tcl
-# End:
-