diff options
-rw-r--r-- | tests/entry.test | 18 | ||||
-rw-r--r-- | tests/font.test | 6 | ||||
-rw-r--r-- | tests/spinbox.test | 23 | ||||
-rw-r--r-- | tests/textDisp.test | 2 | ||||
-rw-r--r-- | tests/textWind.test | 4 | ||||
-rw-r--r-- | tests/winFont.test | 6 |
6 files changed, 42 insertions, 17 deletions
diff --git a/tests/entry.test b/tests/entry.test index eeebe5d..785dd0b 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -2305,10 +2305,20 @@ test entry-8.18 {DeleteChars procedure} -setup { .e insert 0 "xyzzy" update .e delete 2 4 - winfo reqwidth .e -} -cleanup { - destroy .e -} -result {31} + # To check that deletion actually happened we measure the new width + # of the widget, based on the measuring width of the remaining text ("xyy") + # in the widget. For that purpose we have to mirror the code in tkEntry.c + # for computation of the reqwidth + # note: XPAD corresponds to the hardcoded #define XPAD 1 + set XPAD 1 + set expected [expr { [font measure [.e cget -font] "xyy"] \ + + 2 * ( [.e cget -borderwidth] + \ + [.e cget -highlightthickness] + $XPAD ) } ] + expr {[winfo reqwidth .e] == $expected} +} -cleanup { + destroy .e + unset XPAD expected +} -result {1} test entry-9.1 {EntryValueChanged procedure} -setup { unset -nocomplain x diff --git a/tests/font.test b/tests/font.test index 7e37698..b8c0144 100644 --- a/tests/font.test +++ b/tests/font.test @@ -141,7 +141,7 @@ test font-4.9 {font command: actual} -constraints {unix noExceed} -body { 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} @@ -153,7 +153,7 @@ test font-4.13 {font command: actual} -body { } -match glob -result {*} test font-4.14 {font command: actual} -constraints win -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 } -returnCodes 1 -match glob -result {expected a single character but got "*"} @@ -2345,7 +2345,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 {unix noExceed} -body { # can fail on Unix systems that have a real "times new roman" font font actual {{times new roman} 10} -family diff --git a/tests/spinbox.test b/tests/spinbox.test index 206a61d..1f2bdac 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -2607,10 +2607,25 @@ test spinbox-8.18 {DeleteChars procedure} -setup { .e insert 0 "xyzzy" update .e delete 2 4 - winfo reqwidth .e -} -cleanup { - destroy .e -} -result {42} + # To check that deletion actually happened we measure the new width + # of the widget, based on the measuring width of the remaining text ("xyy") + # in the widget. For that purpose we have to mirror the code in tkEntry.c + # for computation of the reqwidth + # note: XPAD corresponds to the hardcoded #define XPAD 1 + set XPAD 1 + set buttonWidth [expr { [font measure [.e cget -font] "0"] + 2 * (1 + $XPAD) }] + if {$buttonWidth < 11} { + set buttonWidth 11 + } + set expected [expr { [font measure [.e cget -font] "xyy"] \ + + 2 * ( [.e cget -borderwidth] + \ + [.e cget -highlightthickness] + $XPAD ) \ + + $buttonWidth } ] + expr {[winfo reqwidth .e] == $expected} +} -cleanup { + destroy .e + unset XPAD buttonWidth expected +} -result {1} test spinbox-9.1 {SpinboxValueChanged procedure} -setup { unset -nocomplain x diff --git a/tests/textDisp.test b/tests/textDisp.test index 5393533..c413b40 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -41,7 +41,7 @@ catch {destroy .f .t} frame .f -width 100 -height 20 pack append . .f left -set fixedFont {Courier -12} +set fixedFont {"Courier New" -12} # 15 on XP, 13 on Solaris 8 set fixedHeight [font metrics $fixedFont -linespace] # 7 on all platforms diff --git a/tests/textWind.test b/tests/textWind.test index b0359f9..f5a5152 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -16,7 +16,7 @@ tcltest::loadTestedCommands option add *Text.borderWidth 2 option add *Text.highlightThickness 2 -option add *Text.font {Courier -12} +option add *Text.font {"Courier New" -12} deleteWindows @@ -27,7 +27,7 @@ update .t debug on # 15 on XP, 13 on Solaris 8 -set fixedHeight [font metrics {Courier -12} -linespace] +set fixedHeight [font metrics {"Courier New" -12} -linespace] set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP set color [expr {[winfo depth .t] > 1 ? "green" : "black"}] diff --git a/tests/winFont.test b/tests/winFont.test index 08a53ff..93aeca9 100644 --- a/tests/winFont.test +++ b/tests/winFont.test @@ -71,7 +71,7 @@ test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} -constraints lappend x [font actual {-family "Times"} -family] lappend x [font actual {-family "New York"} -family] lappend x [font actual {-family "Times New Roman"} -family] -} -result {{Times New Roman} {Times New Roman} {Times New Roman}} +} -result {Times Times {Times New Roman}} test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} -constraints { win } -setup { @@ -80,7 +80,7 @@ test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} -constraint lappend x [font actual {-family "Courier"} -family] lappend x [font actual {-family "Monaco"} -family] lappend x [font actual {-family "Courier New"} -family] -} -result {{Courier New} {Courier New} {Courier New}} +} -result {Courier Courier {Courier New}} test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} -constraints { win } -setup { @@ -89,7 +89,7 @@ test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} -constrai lappend x [font actual {-family "Helvetica"} -family] lappend x [font actual {-family "Geneva"} -family] lappend x [font actual {-family "Arial"} -family] -} -result {Arial Arial Arial} +} -result {Helvetica Helvetica Arial} test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} -constraints { win } -body { |