← Back to branch summary

~ubuntu-branches/ubuntu/dapper/tk8.0/dapper-updates

« back to all changes in this revision

Viewing changes to tests/winFont.test

  • Committer: Bazaar Package Importer
  • Author(s): Mike Markley
  • Date: 2001-07-24 21:57:40 UTC
  • Revision ID: james.westby@ubuntu.com-20010724215740-r70t25rtmbqjil2h
Tags: upstream-8.0.5
Import upstream version 8.0.5

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/winFont.test
 
1
# This file is a Tcl script to test out the procedures in tkWinFont.c. 
 
2
# It is organized in the standard fashion for Tcl tests.
 
3
#
 
4
# Many of these tests are visually oriented and cannot be checked
 
5
# programmatically (such as "does an underlined font appear to be
 
6
# underlined?"); these tests attempt to exercise the code in question,
 
7
# but there are no results that can be checked.  
 
8
#
 
9
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
 
10
#
 
11
# See the file "license.terms" for information on usage and redistribution
 
12
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
13
#
 
14
# RCS: @(#) $Id: winFont.test,v 1.3 1998/09/14 18:23:53 stanton Exp $
 
15
 
 
16
if {$tcl_platform(platform)!="windows"} {
 
17
    return
 
18
}
 
19
 
 
20
if {[string compare test [info procs test]] != 0} {
 
21
    source defs
 
22
}
 
23
 
 
24
catch {destroy .b}
 
25
catch {font delete xyz}
 
26
 
 
27
toplevel .b
 
28
update idletasks
 
29
 
 
30
set courier {Courier 14}
 
31
set cx [font measure $courier 0]
 
32
 
 
33
label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed
 
34
pack .b.l
 
35
canvas .b.c -closeenough 0
 
36
 
 
37
set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
 
38
pack .b.c
 
39
update
 
40
 
 
41
set ax [winfo reqwidth .b.l]
 
42
set ay [winfo reqheight .b.l]
 
43
proc getsize {} {
 
44
    update
 
45
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
 
46
}
 
47
 
 
48
test winfont-1.1 {TkpGetNativeFont procedure: not native} {
 
49
    list [catch {font measure {} xyz} msg] $msg
 
50
} {1 {font "" doesn't exist}}
 
51
test winfont-1.2 {TkpGetNativeFont procedure: native} {
 
52
    font measure ansifixed 0
 
53
    font measure ansi 0
 
54
    font measure device 0
 
55
    font measure oemfixed 0
 
56
    font measure systemfixed 0
 
57
    font measure system 0
 
58
    set x {}
 
59
} {}
 
60
 
 
61
test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {
 
62
    expr [font actual {-size -10} -size]>0
 
63
} {1}
 
64
test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {
 
65
    expr [font actual {-family Arial} -size]>0
 
66
} {1}
 
67
test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {
 
68
    font actual {-weight normal} -weight
 
69
} {normal}
 
70
test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {
 
71
    font actual {-weight bold} -weight
 
72
} {bold}
 
73
test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {
 
74
    catch {expr {[font actual {-size 10} -size]}}
 
75
} 0
 
76
test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {
 
77
    font actual {-family Arial} -family
 
78
} {Arial}
 
79
test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {
 
80
    set x {}
 
81
    lappend x [font actual {-family "Times"} -family]
 
82
    lappend x [font actual {-family "New York"} -family]
 
83
    lappend x [font actual {-family "Times New Roman"} -family]
 
84
} {{Times New Roman} {Times New Roman} {Times New Roman}}
 
85
test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {
 
86
    set x {}
 
87
    lappend x [font actual {-family "Courier"} -family]
 
88
    lappend x [font actual {-family "Monaco"} -family]
 
89
    lappend x [font actual {-family "Courier New"} -family]
 
90
} {{Courier New} {Courier New} {Courier New}}
 
91
test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
 
92
    set x {}
 
93
    lappend x [font actual {-family "Helvetica"} -family]
 
94
    lappend x [font actual {-family "Geneva"} -family]
 
95
    lappend x [font actual {-family "Arial"} -family]
 
96
} {Arial Arial Arial}
 
97
test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {
 
98
    # No way to get it to fail! Any font name is acceptable.
 
99
} {}
 
100
 
 
101
test winfont-3.1 {TkpDeleteFont procedure} {
 
102
    font actual {-family xyz}
 
103
    set x {}
 
104
} {}
 
105
 
 
106
test winfont-4.1 {TkpGetFontFamilies procedure} {
 
107
    font families
 
108
    set x {}
 
109
} {}
 
110
 
 
111
test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
 
112
    .b.l config -wrap 0 -text "000000"
 
113
    getsize
 
114
} "[expr $ax*6] $ay"
 
115
test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
 
116
    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
 
117
    getsize
 
118
} "[expr $ax*256] $ay"
 
119
test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
 
120
    .b.l config -wrap [expr $ax*10] -text "00000000"
 
121
    getsize
 
122
} "[expr $ax*8] $ay"
 
123
test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
 
124
    .b.l config -wrap [expr $ax*6] -text "00000000"
 
125
    getsize
 
126
} "[expr $ax*6] [expr $ay*2]"
 
127
test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {
 
128
    .b.c dchars $t 0 end
 
129
    .b.c insert $t 0 "0000"
 
130
    .b.c index $t @[expr int($cx*2.5)],1
 
131
} {2}
 
132
test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} { 
 
133
    .b.l config -text "000000" -wrap 1
 
134
    getsize
 
135
} "$ax [expr $ay*6]"
 
136
test winfont-5.7 {Tk_MeasureChars procedure: whole words} {
 
137
    .b.l config -wrap [expr $ax*8] -text "000000 0000"
 
138
    getsize
 
139
} "[expr $ax*6] [expr $ay*2]"
 
140
test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {
 
141
    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
 
142
    getsize
 
143
} "[expr $ax*7] [expr $ay*2]"
 
144
test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {
 
145
    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
 
146
    getsize
 
147
} "[expr $ax*7] [expr $ay*2]"
 
148
test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
 
149
    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
 
150
    getsize
 
151
} "[expr $ax*12] [expr $ay*2]"
 
152
test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} {
 
153
    set font [.b.l cget -font]
 
154
    .b.l config -font {{MS Sans Serif} 8} -text "W"
 
155
    set width [winfo reqwidth .b.l]
 
156
    .b.l config -text "XaYoYaKaWx"
 
157
    set x [lindex [getsize] 0]
 
158
    .b.l config -font $font
 
159
    expr $x < ($width*10)
 
160
} 1
 
161
test winfont-6.1 {Tk_DrawChars procedure: loop test} {
 
162
    .b.l config -text "a"
 
163
    update
 
164
} {}
 
165
 
 
166
test winfont-7.1 {AllocFont procedure: use old font} {
 
167
    font create xyz
 
168
    catch {destroy .c}
 
169
    button .c -font xyz
 
170
    font configure xyz -family times
 
171
    update
 
172
    destroy .c
 
173
    font delete xyz
 
174
} {}
 
175
test winfont-7.2 {AllocFont procedure: extract info from logfont} {
 
176
    font actual {arial 10 bold italic underline overstrike}
 
177
} {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
 
178
test winfont-7.3 {AllocFont procedure: extract info from textmetric} {
 
179
    font metric {arial 10 bold italic underline overstrike} -fixed
 
180
} {0}
 
181
test winfont-7.4 {AllocFont procedure: extract info from textmetric} {
 
182
    font metric systemfixed -fixed
 
183
} {1}
 
184
 
 
185
destroy .b