diff options
Diffstat (limited to 'tests/font.test')
| -rw-r--r-- | tests/font.test | 100 |
1 files changed, 50 insertions, 50 deletions
diff --git a/tests/font.test b/tests/font.test index b3e286a..e4cd59b 100644 --- a/tests/font.test +++ b/tests/font.test @@ -2,8 +2,8 @@ # plus the procedures in tkFont.c. It is organized in the # standard white-box fashion for Tcl tests. # -# Copyright (c) 1996-1998 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1996-1998 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. package require tcltest 2.2 @@ -13,7 +13,7 @@ tcltest::loadTestedCommands # Some tests require support for 4-byte UTF-8 sequences testConstraint fullutf [expr {[format %c 0x010000] != "\uFFFD"}] - +testConstraint utfcompat [expr {([string length "\U10000"] == 2) && [package vsatisfies [package provide Tcl] 8]}] testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] @@ -116,21 +116,21 @@ test font-4.1 {font command: actual: arguments} -body { test font-4.2 {font command: actual: arguments} -body { # (objc < 3) font actual -} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"} +} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?-option? ?--? ?char?"} test font-4.3 {font command: actual: arguments} -body { # (objc - skip > 4) when skip == 0 font actual xyz abc def -} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"} +} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?-option? ?--? ?char?"} test font-4.4 {font command: actual: displayof specified, so skip to next} -body { catch {font actual xyz -displayof . -size} -} -result {0} +} -result 0 test font-4.5 {font command: actual: displayof specified, so skip to next} -body { lindex [font actual xyz -displayof .] 0 } -result {-family} test font-4.6 {font command: actual: arguments} -body { # (objc - skip > 4) when skip == 2 font actual xyz -displayof . abc def -} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"} +} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?-option? ?--? ?char?"} test font-4.7 {font command: actual: arguments} -constraints noExceed -body { # (tkfont == NULL) font actual "\{xyz" @@ -146,25 +146,25 @@ test font-4.9 {font command: actual} -constraints {unix noExceed failsOnUbuntu} test font-4.10 {font command: actual} -constraints win -body { # (objc > 3) so objPtr = objv[3 + skip] font actual {-family times} -family -} -result {Times New Roman} +} -result {times} test font-4.11 {font command: bad option} -body { font actual xyz -style } -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike} test font-4.12 {font command: actual} -body { - font actual {-family times} -- \ud800 + font actual {-family times} -- \uD800 } -match glob -result {*} test font-4.13 {font command: actual} -body { - font actual {-family times} -- \udc00 + font actual {-family times} -- \uDC00 } -match glob -result {*} -test font-4.14 {font command: actual} -constraints win -body { +test font-4.14 {font command: actual} -constraints {utfcompat win knownBug} -body { font actual {-family times} -family -- \uD800\uDC00 -} -result {Times New Roman} +} -result {times} test font-4.15 {font command: actual} -body { - font actual {-family times} -- \udc00\ud800 + font actual {-family times} -- \uDC00\uD800 } -returnCodes 1 -match glob -result {expected a single character but got "*"} -test font-4.16 {font command: actual} -constraints {fullutf win} -body { +test font-4.16 {font command: actual} -constraints {fullutf win knownBug} -body { font actual {-family times} -family -- \U10000 -} -result {Times New Roman} +} -result {times} test font-5.1 {font command: configure} -body { @@ -432,15 +432,15 @@ test font-10.2 {font command: metrics: arguments} -body { test font-10.3 {font command: metrics: arguments} -body { # (objc < 3) font metrics -} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?option?"} +} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?-option?"} test font-10.4 {font command: metrics: arguments} -body { # (objc - skip) > 4) when skip == 0 font metrics xyz abc def -} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?option?"} +} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?-option?"} test font-10.5 {font command: metrics: arguments} -body { # (objc - skip) > 4) when skip == 2 font metrics xyz -displayof . abc -} -returnCodes error -result {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed} +} -returnCodes error -result {bad metric "abc": must be -ascent, -descent, -fixed, or -linespace} test font-10.6 {font command: metrics: bad font} -constraints noExceed -body { # (tkfont == NULL) font metrics "\{xyz" @@ -457,7 +457,7 @@ test font-10.7 {font command: metrics: get all metrics} -setup { test font-10.8 {font command: metrics: bad metric} -body { # (Tcl_GetIndexFromObj() != TCL_OK) font metrics $fixed -xyz -} -returnCodes error -result {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed} +} -returnCodes error -result {bad metric "-xyz": must be -ascent, -descent, -fixed, or -linespace} test font-10.9 {font command: metrics: get individual metrics} -body { font metrics $fixed -ascent font metrics $fixed -descent @@ -538,7 +538,7 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { } -cleanup { destroy .t.f font delete xyz -} -result {1} +} -result 1 test font-13.1 {CreateNamedFont: new named font} -setup { @@ -1683,14 +1683,14 @@ destroy .t.f pack [label .t.f] update test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} -body { - .t.f config -text "foo" -under -1 + .t.f config -text "foo" -underline {} } -result {} test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} -body { .t.f config -text "000 00000" -wrap [expr $ax*7] -under 10 } -result {} test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} -body { .t.f config -text "000 00000" -wrap [expr $ax*7] -under 5 - .t.f config -wrap -1 -under -1 + .t.f config -wrap -1 -underline {} } -result {} destroy .t.f @@ -1705,7 +1705,7 @@ update test font-28.1 {Tk_PointToChar procedure: above all lines} -body { csetup "000" .t.c index text @-1,0 -} -result {0} +} -result 0 test font-28.2 {Tk_PointToChar procedure: no chars} -body { # After fixing the following bug: # @@ -1717,46 +1717,46 @@ test font-28.2 {Tk_PointToChar procedure: no chars} -body { csetup "" .t.c index text @100,100 -} -result {0} +} -result 0 test font-28.3 {Tk_PointToChar procedure: loop test} -body { csetup "000\n000\n000\n000" .t.c index text @10000,0 -} -result {3} +} -result 3 test font-28.4 {Tk_PointToChar procedure: intersect line} -body { csetup "000\n000\n000" .t.c index text @0,$ay -} -result {4} +} -result 4 test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} -body { csetup "000\n000\n000" .t.c index text @-100,$ay -} -result {4} +} -result 4 test font-28.6 {Tk_PointToChar procedure: past any possible chunk} -body { csetup "000\n000\n000" .t.c index text @100000,$ay -} -result {7} +} -result 7 test font-28.7 {Tk_PointToChar procedure: which chunk on this line} -body { csetup "000\n000\t000\t000\n000" .t.c index text @[expr $ax*2],$ay -} -result {6} +} -result 6 test font-28.8 {Tk_PointToChar procedure: which chunk on this line} -body { csetup "000\n000\t000\t000\n000" .t.c index text @[expr $ax*10],$ay -} -result {10} +} -result 10 test font-28.9 {Tk_PointToChar procedure: in special chunk} -body { csetup "000\n000\t000\t000\n000" .t.c index text @[expr $ax*6],$ay -} -result {7} +} -result 7 test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} -body { csetup "000 0000000" .t.c itemconfig text -width [expr $ax*5] set x [.t.c index text @[expr $ax*5],0] .t.c itemconfig text -width 0 return $x -} -result {3} +} -result 3 test font-28.11 {Tk_PointToChar procedure: below all chunks} -body { csetup "000 0000000" .t.c index text @0,1000000 -} -result {11} +} -result 11 destroy .t.c @@ -1765,7 +1765,7 @@ destroy .t.f pack [label .t.f] update test font-29.1 {Tk_CharBBox procedure: index < 0} -body { - .t.f config -text "000" -underline -1 + .t.f config -text "000" -underline {} } -result {} test font-29.2 {Tk_CharBBox procedure: loop} -body { .t.f config -text "000\t000\t000\t000" -underline 9 @@ -1803,7 +1803,7 @@ test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} -body { return $x } -cleanup { bind all <Enter> {} -} -result {0} +} -result 0 test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body { csetup "000\n000\n000" .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} @@ -1813,7 +1813,7 @@ test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body { return $x } -cleanup { bind all <Enter> {} -} -result {5} +} -result 5 test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} -body { csetup "000\n0\n000" .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} @@ -1833,7 +1833,7 @@ test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} -bo return $x } -cleanup { bind all <Enter> {} -} -result {3} +} -result 3 test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} -body { csetup "000\n0\n000" .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} @@ -1886,7 +1886,7 @@ test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} -body { return $x } -cleanup { bind all <Enter> {} -} -result {0} +} -result 0 test font-30.10 {Tk_DistanceToTextLayout procedure: above line} -body { csetup "0\n000" .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} @@ -1916,7 +1916,7 @@ test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body { return $x } -cleanup { bind all <Enter> {} -} -result {3} +} -result 3 .t.c itemconfig text -justify left test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body { csetup "000" @@ -1927,7 +1927,7 @@ test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body { return $x } -cleanup { bind all <Enter> {} -} -result {1} +} -result 1 destroy .t.c @@ -1973,7 +1973,7 @@ test font-31.7 {TkIntersectAngledTextLayout procedure: bug [514ff64dd0]} -body { # The text has been rotated 90 degrees around it's upper left corner, # so it's enough to check with a small rectangle with small negative y coords. .t.c find overlapping 5 -7 7 -5 -} -result {1} +} -result 1 destroy .t.c @@ -2184,7 +2184,7 @@ test font-37.3 {GetAttributeInfo procedure: size} -setup { font config xyz -size } -cleanup { font delete xyz -} -result {20} +} -result 20 test font-37.4 {GetAttributeInfo procedure: weight} -setup { catch {font delete xyz} set x {} @@ -2211,7 +2211,7 @@ test font-37.6 {GetAttributeInfo procedure: underline} -setup { font config xyz -underline } -cleanup { font delete xyz -} -result {1} +} -result 1 test font-37.7 {GetAttributeInfo procedure: overstrike} -setup { catch {font delete xyz} set x {} @@ -2220,7 +2220,7 @@ test font-37.7 {GetAttributeInfo procedure: overstrike} -setup { font config xyz -overstrike } -cleanup { font delete xyz -} -result {0} +} -result 0 # In tests below, one field is set to "xyz" so that font name doesn't @@ -2347,7 +2347,7 @@ test font-44.1 {TkFontGetPixels: size < 0} -constraints failsOnUbuntu -setup { font actual {times -12} -size } -cleanup { tk scaling $oldscale -} -result {24} +} -result 24 test font-44.2 {TkFontGetPoints: size >= 0} -constraints {noExceed failsOnUbuntuNoXft} -setup { set oldscale [tk scaling] } -body { @@ -2355,7 +2355,7 @@ test font-44.2 {TkFontGetPoints: size >= 0} -constraints {noExceed failsOnUbuntu font actual {times 12} -size } -cleanup { tk scaling $oldscale -} -result {12} +} -result 12 test font-45.1 {TkFontGetAliasList: no match} -body { @@ -2363,7 +2363,7 @@ test font-45.1 {TkFontGetAliasList: no match} -body { } -result [font actual {-size 10} -family] test font-45.2 {TkFontGetAliasList: match} -constraints win -body { font actual {times 10} -family -} -result {Times New Roman} +} -result {times} test font-45.3 {TkFontGetAliasList: match} -constraints {noExceed failsOnUbuntu} -body { if {[font actual {{times new roman} 10} -family] eq "Times New Roman"} { # avoid test failure on systems that have a real "times new roman" font @@ -2372,7 +2372,7 @@ test font-45.3 {TkFontGetAliasList: match} -constraints {noExceed failsOnUbuntu} set res [expr {[font actual {{times new roman} 10} -family] eq \ [font actual {times 10} -family]} ] } -} -result {1} +} -result 1 test font-46.1 {font actual, with character, no option, no --} -body { @@ -2408,7 +2408,7 @@ test font-47.1 {Bug f214b8ad5b} -body { interp delete two } -result {} -test font-47.2 {Bug 3049518,TIP 608 - Canvas} -body { +test font-47.2 {Bug 3049518 - Canvas} -body { if {"MyFont" ni [font names]} { font create MyFont -family "Liberation Sans" -size 13 } @@ -2474,7 +2474,7 @@ test font-47.2 {Bug 3049518,TIP 608 - Canvas} -body { unset -nocomplain ::results } -result {{1 2} called-.t.c {1 2} called-.t.c {1 2} called-.t.c {1 2}} -test font-47.3 {Bug 3049518, TIP 608 - Label} -body { +test font-47.3 {Bug 3049518 - Label} -body { if {"MyFont" ni [font names]} { font create MyFont -family "Liberation Sans" -size 13 } |