OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [unixFont.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file is a Tcl script to test out the procedures in tkUnixFont.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.  Some tests depend on the
8 
# fonts having or not having certain properties, which may not be valid
9 
# at all sites.
10 
#
11 
# Copyright (c) 1996 Sun Microsystems, Inc.
12 
#
13 
# See the file "license.terms" for information on usage and redistribution
14 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 
#
16 
# RCS: @(#) $Id: unixFont.test,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $
17 
 
18 
if {$tcl_platform(platform)!="unix"} {
19 
    return
20 
}
21 
 
22 
if {[string compare test [info procs test]] != 0} {
23 
    source defs
24 
}
25 
 
26 
catch {destroy .b}
27 
toplevel .b
28 
wm geom .b +0+0
29 
update idletasks
30 
 
31 
# Font should be fixed width and have chars missing below char 32, so can
32 
# test control char expansion and missing character code.
33 
 
34 
set courier {Courier -10}
35 
set cx [font measure $courier 0]
36 
 
37 
label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font fixed
38 
pack .b.l
39 
canvas .b.c -closeenough 0
40 
 
41 
set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
42 
pack .b.c
43 
update
44 
 
45 
set ax [winfo reqwidth .b.l]
46 
set ay [winfo reqheight .b.l]
47 
proc getsize {} {
48 
    update
49 
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
50 
}
51 
 
52 
test unixfont-1.1 {TkpGetNativeFont procedure: not native} {
53 
    list [catch {font measure {} xyz} msg] $msg
54 
} {1 {font "" doesn't exist}}
55 
test unixfont-1.2 {TkpGetNativeFont procedure: native} {
56 
    font measure fixed 0
57 
} {6}
58 
 
59 
test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
60 
    font actual {-size 10}
61 
    set x {}
62 
} {}
63 
test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} {
64 
    set x {}
65 
    lappend x [lindex [font actual {-family "Times New Roman"}] 1]
66 
    lappend x [lindex [font actual {-family "New York"}] 1]
67 
    lappend x [lindex [font actual {-family "Times"}] 1]
68 
} {times times times}
69 
test unixfont-2.3 {TkpGetFontFromAttributes procedure: Courier relatives} {
70 
    set x {}
71 
    lappend x [lindex [font actual {-family "Courier New"}] 1]
72 
    lappend x [lindex [font actual {-family "Monaco"}] 1]
73 
    lappend x [lindex [font actual {-family "Courier"}] 1]
74 
} {courier courier courier}
75 
test unixfont-2.4 {TkpGetFontFromAttributes procedure: Helvetica relatives} {
76 
    set x {}
77 
    lappend x [lindex [font actual {-family "Arial"}] 1]
78 
    lappend x [lindex [font actual {-family "Geneva"}] 1]
79 
    lappend x [lindex [font actual {-family "Helvetica"}] 1]
80 
} {helvetica helvetica helvetica}
81 
test unixfont-2.5 {TkpGetFontFromAttributes procedure: fallback} {
82 
    font actual {-xyz-xyz-*-*-*-*-*-*-*-*-*-*-*-*}
83 
    set x {}
84 
} {}
85 
test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} {
86 
    lindex [font actual {-family fixed -size 10}] 1
87 
} {fixed}
88 
test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} {
89 
    # no test available
90 
} {}
91 
test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} {
92 
    lindex [font actual {-family fixed -size 31}] 1
93 
} {fixed}
94 
test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {
95 
    lindex [font actual {-family courier}] 1
96 
} {courier}
97 
test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} {
98 
    lindex [font actual {-family courier -size 37}] 3
99 
} {37}
100 
test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} {
101 
    # On Linux, XListFonts() was returning names for fonts that do not
102 
    # actually exist, causing the subsequent XLoadQueryFont() to fail
103 
    # unexpectedly.  Now falls back to another font if that happens.
104 
 
105 
    font actual {-size 14}
106 
    set x {}
107 
} {}
108 
 
109 
test unixfont-3.1 {TkpDeleteFont procedure} {
110 
    font actual {-family xyz}
111 
    set x {}
112 
} {}
113 
 
114 
test unixfont-4.1 {TkpGetFontFamilies procedure} {
115 
    font families
116 
    set x {}
117 
} {}
118 
 
119 
test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} {
120 
    .b.l config -text "000000" -wrap [expr $ax*3]
121 
    .b.l config -wrap 0
122 
} {}
123 
test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} {
124 
    .b.l config -text "000000"
125 
} {}
126 
test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} {
127 
    .b.l config -text "0"
128 
    .b.l config -text "\377"
129 
    .b.l config -text "0\3770\377"
130 
    .b.l config -text "000000000000000"
131 
} {}
132 
.b.l config -wrap [expr $ax*10]
133 
test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} {
134 
    .b.l config -text "0000000000000"
135 
    getsize
136 
} "[expr $ax*10] [expr $ay*2]"
137 
test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} {
138 
    .b.l config -text "000000"
139 
    getsize
140 
} "[expr $ax*6] $ay"
141 
test unixfont-5.6 {Tk_MeasureChars procedure: find last word} {
142 
    .b.l config -text "000000 00000"
143 
    getsize
144 
} "[expr $ax*6] [expr $ay*2]"
145 
test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} {
146 
    .b.l config -text "000000     00000"
147 
    getsize
148 
} "[expr $ax*6] [expr $ay*2]"
149 
test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} {
150 
    .b.l config -text "00  000     00000"
151 
    getsize
152 
} "[expr $ax*7] [expr $ay*2]"
153 
test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} {
154 
    .b.c dchars $t 0 end
155 
    .b.c insert $t 0 "0000"
156 
    .b.c index $t @[expr int($ax*2.5)],1
157 
} {2}
158 
test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} {
159 
    .b.l config -text "000000000000"
160 
    getsize
161 
} "[expr $ax*10] [expr $ay*2]"
162 
test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} {
163 
    set a [.b.l cget -wrap]
164 
    .b.l config -text "000000" -wrap 1
165 
    set x [getsize]
166 
    .b.l config -wrap $a
167 
    set x
168 
} "$ax [expr $ay*6]"
169 
test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} {
170 
    .b.l config -text "000   \n000"
171 
    getsize
172 
} "[expr $ax*6] [expr $ay*2]"
173 
 
174 
test unixfont-6.1 {Tk_DrawChars procedure: loop test} {
175 
    .b.l config -text "a"
176 
    update
177 
} {}
178 
test unixfont-6.2 {Tk_DrawChars procedure: loop test} {
179 
    .b.l config -text "abcd"
180 
    update
181 
} {}
182 
test unixfont-6.3 {Tk_DrawChars procedure: special char} {
183 
    .b.l config -text "\001"
184 
    update
185 
} {}
186 
test unixfont-6.4 {Tk_DrawChars procedure: normal then special} {
187 
    .b.l config -text "ab\001"
188 
    update
189 
} {}
190 
test unixfont-6.5 {Tk_DrawChars procedure: ends with special} {
191 
    .b.l config -text "ab\001"
192 
    update
193 
} {}
194 
test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} {
195 
    .b.l config -text "ab\001def"
196 
    update
197 
} {}
198 
 
199 
test unixfont-7.1 {DrawChars procedure: no effects} {
200 
    .b.l config -text "abc"
201 
    update
202 
} {}
203 
test unixfont-7.2 {DrawChars procedure: underlining} {
204 
    set f [.b.l cget -font]
205 
    .b.l config -text "abc" -font "courier 10 underline"
206 
    update
207 
    .b.l config -font $f
208 
} {}
209 
test unixfont-7.3 {DrawChars procedure: overstrike} {
210 
    set f [.b.l cget -font]
211 
    .b.l config -text "abc" -font "courier 10 overstrike"
212 
    update
213 
    .b.l config -font $f
214 
} {}
215 
 
216 
test unixfont-8.1 {AllocFont procedure: use old font} {
217 
    font create xyz
218 
    button .c -font xyz
219 
    font configure xyz -family times
220 
    update
221 
    destroy .c
222 
    font delete xyz
223 
} {}
224 
test unixfont-8.2 {AllocFont procedure: parse information from XLFD} {
225 
    expr [lindex [font actual {-family times -size 0}] 3]==0
226 
} {0}
227 
test unixfont-8.3 {AllocFont procedure: can't parse info from name} {
228 
    if [catch {set a [font actual a12biluc]}]==0 {
229 
        string compare $a "-family a12biluc -size 0 -weight normal -slant roman -underline 0 -overstrike 0"
230 
    } else {
231 
        set a 0
232 
    }
233 
} {0}
234 
test unixfont-8.4 {AllocFont procedure: classify characters} {
235 
    set x 0
236 
    incr x [font measure $courier "\001"]   ;# 4
237 
    incr x [font measure $courier "\002"]   ;# 4
238 
    incr x [font measure $courier "\012"]   ;# 2
239 
    incr x [font measure $courier "\101"]   ;# 1
240 
    set x
241 
} [expr $cx*11]
242 
test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} {
243 
    font metrics $courier -fixed
244 
} {1}
245 
test unixfont-8.6 {AllocFont procedure: setup widths of special chars} {
246 
    set x 0
247 
    incr x [font measure $courier "\001"]   ;# 4
248 
    incr x [font measure $courier "\002"]   ;# 4
249 
    incr x [font measure $courier "\012"]   ;# 2
250 
    set x
251 
} [expr $cx*10]
252 
test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} {
253 
    catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
254 
    set x {}
255 
} {}
256 
test unixfont-8.8 {AllocFont procedure: no XA_UNDERLINE_POSITION} {
257 
    catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific}
258 
    set x {}
259 
} {}
260 
test unixfont-8.9 {AllocFont procedure: XA_UNDERLINE_THICKNESS} {
261 
    catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
262 
    set x {}
263 
} {}
264 
test unixfont-8.10 {AllocFont procedure: no XA_UNDERLINE_THICKNESS} {
265 
    catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific}
266 
    set x {}
267 
} {}
268 
test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} {
269 
    catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
270 
    set x {}
271 
} {}
272 
 
273 
test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} {
274 
    .b.c dchars $t 0 end
275 
    .b.c insert $t 0 "0\a0"
276 
    set x {}
277 
    lappend x [.b.c index $t @[expr $ax*0],0]
278 
    lappend x [.b.c index $t @[expr $ax*1],0]
279 
    lappend x [.b.c index $t @[expr $ax*2],0]
280 
    lappend x [.b.c index $t @[expr $ax*3],0]
281 
} {0 1 1 2}
282 
test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {
283 
    .b.c dchars $t 0 end
284 
    .b.c insert $t 0 "0\1770"
285 
    set x {}
286 
    lappend x [.b.c index $t @[expr $ax*0],0]
287 
    lappend x [.b.c index $t @[expr $ax*1],0]
288 
    lappend x [.b.c index $t @[expr $ax*2],0]
289 
    lappend x [.b.c index $t @[expr $ax*3],0]
290 
    lappend x [.b.c index $t @[expr $ax*4],0]
291 
    lappend x [.b.c index $t @[expr $ax*5],0]
292 
} {0 1 1 1 1 2}
293 
 

powered by: WebSVN 2.1.0

© copyright 1999-2025 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.