diff options
author | stanton <stanton> | 1999-04-16 01:51:06 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-04-16 01:51:06 (GMT) |
commit | 03656f44f81469f459031fa3a4a7b09c8bc77712 (patch) | |
tree | 31378e81bd58f8c726fc552d6b30cbf3ca07497b /tests/winFont.test | |
parent | 404fc236f34304df53b7e44bc7971d786b87d453 (diff) | |
download | tk-03656f44f81469f459031fa3a4a7b09c8bc77712.zip tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.gz tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.bz2 |
* Merged 8.1 branch into the main trunk
Diffstat (limited to 'tests/winFont.test')
-rw-r--r-- | tests/winFont.test | 91 |
1 files changed, 51 insertions, 40 deletions
diff --git a/tests/winFont.test b/tests/winFont.test index a02b461..2c2798e 100644 --- a/tests/winFont.test +++ b/tests/winFont.test @@ -7,18 +7,13 @@ # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: winFont.test,v 1.3 1998/09/14 18:23:53 stanton Exp $ - -if {$tcl_platform(platform)!="windows"} { - return -} +# RCS: @(#) $Id: winFont.test,v 1.4 1999/04/16 01:51:43 stanton Exp $ -if {[string compare test [info procs test]] != 0} { - source defs +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {destroy .b} @@ -45,10 +40,10 @@ proc getsize {} { return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" } -test winfont-1.1 {TkpGetNativeFont procedure: not native} { +test winfont-1.1 {TkpGetNativeFont procedure: not native} {pcOnly} { list [catch {font measure {} xyz} msg] $msg } {1 {font "" doesn't exist}} -test winfont-1.2 {TkpGetNativeFont procedure: native} { +test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} { font measure ansifixed 0 font measure ansi 0 font measure device 0 @@ -58,98 +53,99 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} { set x {} } {} -test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} { +test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} { expr [font actual {-size -10} -size]>0 } {1} -test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} { +test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} { expr [font actual {-family Arial} -size]>0 } {1} -test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} { +test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {pcOnly} { font actual {-weight normal} -weight } {normal} -test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} { +test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {pcOnly} { font actual {-weight bold} -weight } {bold} -test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} { +test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {pcOnly} { catch {expr {[font actual {-size 10} -size]}} } 0 -test winfont-2.6 {TkpGetFontFromAttributes procedure: family} { +test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {pcOnly} { font actual {-family Arial} -family } {Arial} -test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} { +test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {pcOnly} { set x {} lappend x [font actual {-family "Times"} -family] lappend x [font actual {-family "New York"} -family] lappend x [font actual {-family "Times New Roman"} -family] } {{Times New Roman} {Times New Roman} {Times New Roman}} -test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} { +test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {pcOnly} { set x {} lappend x [font actual {-family "Courier"} -family] lappend x [font actual {-family "Monaco"} -family] lappend x [font actual {-family "Courier New"} -family] } {{Courier New} {Courier New} {Courier New}} -test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} { +test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {pcOnly} { set x {} lappend x [font actual {-family "Helvetica"} -family] lappend x [font actual {-family "Geneva"} -family] lappend x [font actual {-family "Arial"} -family] } {Arial Arial Arial} -test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} { +test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {pcOnly} { # No way to get it to fail! Any font name is acceptable. } {} -test winfont-3.1 {TkpDeleteFont procedure} { +test winfont-3.1 {TkpDeleteFont procedure} {pcOnly} { font actual {-family xyz} set x {} } {} -test winfont-4.1 {TkpGetFontFamilies procedure} { +test winfont-4.1 {TkpGetFontFamilies procedure} {pcOnly} { font families set x {} } {} -test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} { +test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {pcOnly} { .b.l config -wrap 0 -text "000000" getsize } "[expr $ax*6] $ay" -test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} { +test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {pcOnly} { .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" getsize } "[expr $ax*256] $ay" -test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} { +test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {pcOnly} { .b.l config -wrap [expr $ax*10] -text "00000000" getsize } "[expr $ax*8] $ay" -test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} { +test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {pcOnly} { .b.l config -wrap [expr $ax*6] -text "00000000" getsize } "[expr $ax*6] [expr $ay*2]" -test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} { +test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {pcOnly} { .b.c dchars $t 0 end .b.c insert $t 0 "0000" .b.c index $t @[expr int($cx*2.5)],1 } {2} -test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} { +test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} {pcOnly} { .b.l config -text "000000" -wrap 1 getsize } "$ax [expr $ay*6]" -test winfont-5.7 {Tk_MeasureChars procedure: whole words} { +test winfont-5.7 {Tk_MeasureChars procedure: whole words} {pcOnly} { .b.l config -wrap [expr $ax*8] -text "000000 0000" getsize } "[expr $ax*6] [expr $ay*2]" -test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} { +test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {pcOnly} { .b.l config -wrap [expr $ax*12] -text "000000 0000000" getsize } "[expr $ax*7] [expr $ay*2]" -test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} { +test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {pcOnly} { .b.l config -wrap [expr $ax*12] -text "000 00 00000" getsize } "[expr $ax*7] [expr $ay*2]" -test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} { +test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {pcOnly} { .b.l config -wrap [expr $ax*12] -text "0000000000000000" getsize } "[expr $ax*12] [expr $ay*2]" -test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} { +test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} \ + {pcOnly nonPortable} { set font [.b.l cget -font] .b.l config -font {{MS Sans Serif} 8} -text "W" set width [winfo reqwidth .b.l] @@ -158,12 +154,12 @@ test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} { .b.l config -font $font expr $x < ($width*10) } 1 -test winfont-6.1 {Tk_DrawChars procedure: loop test} { +test winfont-6.1 {Tk_DrawChars procedure: loop test} {pcOnly} { .b.l config -text "a" update } {} -test winfont-7.1 {AllocFont procedure: use old font} { +test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} { font create xyz catch {destroy .c} button .c -font xyz @@ -172,14 +168,29 @@ test winfont-7.1 {AllocFont procedure: use old font} { destroy .c font delete xyz } {} -test winfont-7.2 {AllocFont procedure: extract info from logfont} { +test winfont-7.2 {AllocFont procedure: extract info from logfont} {pcOnly} { font actual {arial 10 bold italic underline overstrike} } {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1} -test winfont-7.3 {AllocFont procedure: extract info from textmetric} { +test winfont-7.3 {AllocFont procedure: extract info from textmetric} {pcOnly} { font metric {arial 10 bold italic underline overstrike} -fixed } {0} -test winfont-7.4 {AllocFont procedure: extract info from textmetric} { +test winfont-7.4 {AllocFont procedure: extract info from textmetric} {pcOnly} { font metric systemfixed -fixed } {1} +# cleanup destroy .b +::tcltest::cleanupTests +return + + + + + + + + + + + + |