1# This file is a Tcl script to test out the procedures in tkMacFont.c. 2# It is organized in the standard fashion for Tcl tests. 3# 4# Some 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 Sun Microsystems, Inc. 10# Copyright (c) 1998-1999 by Scriptics Corporation. 11# All rights reserved. 12# 13# RCS: @(#) $Id: macFont.test,v 1.6 2002/07/14 05:48:46 dgp Exp $ 14 15package require tcltest 2.1 16namespace import -force tcltest::configure 17namespace import -force tcltest::testsDirectory 18configure -testdir [file join [pwd] [file dirname [info script]]] 19configure -loadfile [file join [testsDirectory] constraints.tcl] 20tcltest::loadTestedCommands 21 22catch {destroy .b} 23toplevel .b 24update idletasks 25 26set courier {Courier 12} 27set cx [font measure $courier 0] 28 29set fixed {Monaco 12} 30label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font $fixed 31pack .b.l 32canvas .b.c -closeenough 0 33 34set t [.b.c create text 0 0 -anchor nw -just left -font $courier] 35pack .b.c 36update 37 38set ax [winfo reqwidth .b.l] 39set ay [winfo reqheight .b.l] 40proc getsize {} { 41 update 42 return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" 43} 44 45testConstraint gothic 0 46set gothic {gothic 12} 47set mx [font measure $gothic \u4e4e] 48if {[font actual $gothic -family] != [font actual system -family]} { 49 testConstraint gothic 1 50} 51 52test macFont-1.1 {TkpFontPkgInit} {macOnly} { 53} {} 54 55test macfont-2.1 {TkpGetNativeFont: not native} {macOnly} { 56 list [catch {font measure {} xyz} msg] $msg 57} {1 {font "" doesn't exist}} 58test macFont-2.2 {TkpGetNativeFont: native} {macOnly} { 59 font measure system "0" 60 font measure application "0" 61 set x {} 62} {} 63 64test macFont-3.1 {TkpGetFontFromAttributes: no family} {macOnly} { 65 font actual {-underline 1} -family 66} [font actual system -family] 67test macFont-3.2 {TkpGetFontFromAttributes: long family name} {macOnly} { 68 set x "12345678901234567890123456789012345678901234567890" 69 set x "$x$x$x$x$x$x" 70 font actual "-family $x" -family 71} [font actual system -family] 72test macFont-3.3 {TkpGetFontFromAttributes: family} {macOnly} { 73 font actual {-family Courier} -family 74} {Courier} 75test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {macOnly} { 76 set x {} 77 lappend x [font actual {-family "Times"} -family] 78 lappend x [font actual {-family "Times New Roman"} -family] 79} {Times Times} 80test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {macOnly} { 81 set x {} 82 lappend x [font actual {-family "Courier"} -family] 83 lappend x [font actual {-family "Courier New"} -family] 84} {Courier Courier} 85test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {macOnly} { 86 set x {} 87 lappend x [font actual {-family "Geneva"} -family] 88 lappend x [font actual {-family "Helvetica"} -family] 89 lappend x [font actual {-family "Arial"} -family] 90} {Geneva Helvetica Helvetica} 91test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {macOnly} { 92 font actual {arial 10} -family 93} {Helvetica} 94test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {macOnly} { 95 font actual {{ms sans serif} 10} -family 96} {Chicago} 97test macFont-3.9 {TkpGetFontFromAttributes: styles} {macOnly} { 98 font actual {-weight normal} -weight 99} {normal} 100test macFont-3.10 {TkpGetFontFromAttributes: styles} {macOnly} { 101 font actual {-weight bold} -weight 102} {bold} 103test macFont-3.11 {TkpGetFontFromAttributes: styles} {macOnly} { 104 font actual {-slant roman} -slant 105} {roman} 106test macFont-3.12 {TkpGetFontFromAttributes: styles} {macOnly} { 107 font actual {-slant italic} -slant 108} {italic} 109test macFont-3.13 {TkpGetFontFromAttributes: styles} {macOnly} { 110 font actual {-underline false} -underline 111} {0} 112test macFont-3.14 {TkpGetFontFromAttributes: styles} {macOnly} { 113 font actual {-underline true} -underline 114} {1} 115test macFont-3.15 {TkpGetFontFromAttributes: styles} {macOnly} { 116 font actual {-overstrike false} -overstrike 117} {0} 118test macFont-3.16 {TkpGetFontFromAttributes: styles} {macOnly} { 119 font actual {-overstrike true} -overstrike 120} {0} 121 122test macFont-4.1 {TkpDeleteFont} {macOnly} { 123 font actual {-family xyz} 124 set x {} 125} {} 126 127test macFont-5.1 {TkpGetFontFamilies} {macOnly} { 128 expr {[lsearch [font families] Geneva] > 0} 129} {1} 130 131test macFont-6.1 {TkpGetSubFonts} {testfont gothic macOnly} { 132 .b.l config -text "abc\u4e4e" 133 update 134 set x [testfont subfonts $fixed] 135} "Monaco [font actual $gothic -family]" 136 137test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {macOnly} { 138 .b.l config -wrap 0 -text "000000" 139 getsize 140} "[expr $ax*6] $ay" 141test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {macOnly} { 142 .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" 143 getsize 144} "[expr $ax*256] $ay" 145test macFont-7.3 {Tk_MeasureChars: all chars did fit} {macOnly} { 146 .b.l config -wrap [expr $ax*10] -text "00000000" 147 getsize 148} "[expr $ax*8] $ay" 149test macFont-7.4 {Tk_MeasureChars: not all chars fit} {macOnly} { 150 .b.l config -wrap [expr $ax*6] -text "00000000" 151 getsize 152} "[expr $ax*6] [expr $ay*2]" 153test macFont-7.5 {Tk_MeasureChars: already saw space in line} {macOnly} { 154 .b.l config -wrap [expr $ax*12] -text "000000 0000000" 155 getsize 156} "[expr $ax*7] [expr $ay*2]" 157test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {macOnly} { 158 .b.l config -wrap [expr $ax*12] -text "000 00 00000" 159 getsize 160} "[expr $ax*7] [expr $ay*2]" 161test macFont-7.7 {Tk_MeasureChars: include last partial char} {macOnly} { 162 .b.c dchars $t 0 end 163 .b.c insert $t 0 "0000" 164 .b.c index $t @[expr int($ax*2.5)],1 165} {2} 166test macFont-7.8 {Tk_MeasureChars: at least one char on line} { macOnly} { 167 .b.l config -text "000000" -wrap 1 168 getsize 169} "$ax [expr $ay*6]" 170test macFont-7.9 {Tk_MeasureChars: whole words} {macOnly} { 171 .b.l config -wrap [expr $ax*8] -text "000000 0000" 172 getsize 173} "[expr $ax*6] [expr $ay*2]" 174test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {macOnly} { 175 .b.l config -wrap [expr $ax*12] -text "0000000000000000" 176 getsize 177} "[expr $ax*12] [expr $ay*2]" 178test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {macOnly} { 179 font measure system {} 180} {0} 181test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {macOnly} { 182 font measure $courier abcd 183} "[expr $cx*4]" 184test macFont-7.13 {Tk_MeasureChars: loop on each char} {macOnly} { 185 font measure $courier abcd 186} "[expr $cx*4]" 187test macFont-7.14 {Tk_MeasureChars: p == end} {macOnly} { 188 font measure $courier abcd 189} "[expr $cx*4]" 190test macFont-7.15 {Tk_MeasureChars: p > end} {macOnly} { 191 font measure $courier abc\xc2 192} "[expr $cx*4]" 193test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} { 194 font measure $courier abc\u4e4edef 195} [expr $cx*6+$mx] 196test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} { 197 font measure $courier \u4e4edef 198} [expr $mx+$cx*3] 199test macFont-7.18 {Tk_MeasureChars: final measure} {gothic macOnly} { 200 font measure $courier \u4e4edef 201} [expr $mx+$cx*3] 202test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} { 203 font measure $courier \u4e4e 204} [expr $mx] 205test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {macOnly} { 206 .b.l config -wrap [expr $ax*8] -text "000" 207 getsize 208} "[expr $ax*3] $ay" 209test macFont-7.21 {Tk_MeasureChars: loop on each char} {macOnly} { 210 .b.l config -wrap [expr $ax*8] -text "000" 211 getsize 212} "[expr $ax*3] $ay" 213test macFont-7.22 {Tk_MeasureChars: p == end} {macOnly} { 214 .b.l config -wrap [expr $ax*8] -text "000" 215 getsize 216} "[expr $ax*3] $ay" 217test macFont-7.23 {Tk_MeasureChars: p > end} {macOnly} { 218 .b.l config -wrap [expr $ax*8] -text "00\xc2" 219 getsize 220} "[expr $ax*3] $ay" 221test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} { 222 .b.l config -wrap [expr $ax*8] -text "00\u4e4e00" 223 getsize 224} "[expr $ax*4+$mx] $ay" 225test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} { 226 .b.l config -wrap [expr $ax*8] -text "\u4e4e00" 227 getsize 228} "[expr $mx+$ax*2] $ay" 229test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic macOnly} { 230 .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00" 231 getsize 232} "[expr $ax*8+$mx*2] $ay" 233test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic macOnly} { 234 .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00" 235 getsize 236} "[expr $ax*5] [expr $ay*3]" 237test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic macOnly} { 238 # even some of the "0"s would fit after \u4e4d, they should all wrap to next line. 239 .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00" 240 getsize 241} "[expr $ax*6+$mx] [expr $ay*3]" 242test macFont-7.29 {Tk_MeasureChars: final measure} {gothic macOnly} { 243 .b.l config -wrap [expr $ax*8] -text "\u4e4e00" 244 getsize 245} "[expr $mx+$ax*2] $ay" 246test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} { 247 .b.l config -wrap [expr $ax*8] -text "\u4e4e" 248 getsize 249} "$mx $ay" 250test macFont-7.31 {Tk_MeasureChars: rest == NULL} {macOnly} { 251 .b.l config -wrap [expr $ax*1000] -text 0000 252 getsize 253} "[expr $ax*4] $ay" 254test macFont-7.32 {Tk_MeasureChars: rest != NULL} {macOnly} { 255 .b.l config -wrap [expr $ax*6] -text "00000000" 256 getsize 257} "[expr $ax*6] [expr $ay*2]" 258 259test macFont-8.1 {Tk_DrawChars procedure} {macOnly} { 260 .b.l config -text "a" 261 update 262} {} 263 264test macFont-9.1 {AllocMacFont: use old font} {macOnly} { 265 font create xyz 266 button .c -font xyz 267 font configure xyz -family times 268 update 269 destroy .c 270 font delete xyz 271} {} 272test macFont-9.2 {AllocMacFont: extract info from style} {macOnly} { 273 font actual {Monaco 9 bold italic underline overstrike} 274} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0} 275test macFont-9.3 {AllocMacFont: extract text metrics} {macOnly} { 276 font metric {Geneva 10} -fixed 277} {0} 278test macFont-9.4 {AllocMacFont: extract text metrics} {macOnly} { 279 font metric "Monaco 9" -fixed 280} {1} 281 282destroy .b 283 284# cleanup 285::tcltest::cleanupTests 286return 287