summaryrefslogtreecommitdiffstats
path: root/tests/font.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/font.test')
-rw-r--r--tests/font.test112
1 files changed, 69 insertions, 43 deletions
diff --git a/tests/font.test b/tests/font.test
index dff9fc9..9e44a93 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -12,17 +12,34 @@ eval tcltest::configure $argv
tcltest::loadTestedCommands
-catch {eval font delete [font names]}
+set defaultfontlist [font names]
+
+proc getnondefaultfonts {} {
+ global defaultfontlist
+ set nondeffonts [list ]
+ foreach afont [font names] {
+ if {$afont ni $defaultfontlist} {
+ lappend nondeffonts $afont
+ }
+ }
+ set nondeffonts
+}
+
+proc clearnondefaultfonts {} {
+ foreach afont [getnondefaultfonts] {
+ font delete $afont
+ }
+}
+
deleteWindows
# Toplevel used (in some tests) of the whole file
toplevel .t
wm geom .t +0+0
update idletasks
-case [tk windowingsystem] {
+switch [tk windowingsystem] {
x11 {set fixed "fixed"}
win32 {set fixed "courier 12"}
- classic -
aqua {set fixed "monaco 9"}
}
@@ -162,12 +179,12 @@ test font-5.4 {font command: configure: get all options} -setup {
font delete xyz
} -result xyz
test font-5.5 {font command: configure: get one option} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
# (objc == 4) so objPtr = objv[3]
font create xyz -family xyz
font configure xyz -family
- font names
+ getnondefaultfonts
} -cleanup {
font delete xyz
} -result xyz
@@ -193,34 +210,33 @@ test font-5.7 {font command: configure: bad option} -setup {
test font-6.1 {font command: create: make up name} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
# (objc < 3) so name = NULL
font create
- font names
+ getnondefaultfonts
} -cleanup {
font delete font1
} -result {font1}
test font-6.2 {font command: create: name specified} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
# not (objc < 3)
font create xyz
- font names
+ getnondefaultfonts
} -cleanup {
font delete xyz
} -result {xyz}
test font-6.3 {font command: create: name not really specified} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
# (name[0] == '-') so name = NULL
font create -family xyz
- font names
+ getnondefaultfonts
} -cleanup {
font delete font1
} -result {font1}
test font-6.4 {font command: create: generate name} -setup {
- catch {eval font delete [font names]}
} -body {
# (name == NULL)
font create -family one
@@ -230,7 +246,7 @@ test font-6.4 {font command: create: generate name} -setup {
font create -family four
font configure font2 -family
} -cleanup {
- catch {eval font delete [font names]}
+ font delete font1 font2 font3
} -result {four}
test font-6.5 {font command: create: bad option creating new font} -setup {
catch {font delete xyz}
@@ -239,7 +255,7 @@ test font-6.5 {font command: create: bad option creating new font} -setup {
font create xyz -xyz times
} -returnCodes error -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}
test font-6.6 {font command: create: bad option creating new font} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
# name was not specified so skip = 2
font create -xyz times
@@ -259,7 +275,7 @@ test font-7.1 {font command: delete: arguments} -body {
font delete
} -returnCodes error -result {wrong # args: should be "font delete fontname ?fontname ...?"}
test font-7.2 {font command: delete: loop test} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
set x {}
} -body {
# for (i = 2; i < objc; i++)
@@ -268,14 +284,14 @@ test font-7.2 {font command: delete: loop test} -setup {
font create c -underline 1
font create d -underline 1
font create e -underline 1
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
font delete a e c b
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
} -cleanup {
- catch {eval font delete [font names]}
+ getnondefaultfonts
} -result {{a b c d e} d}
test font-7.3 {font command: delete: loop test} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
set x {}
} -body {
# (namedHashPtr == NULL) in middle of loop
@@ -284,11 +300,11 @@ test font-7.3 {font command: delete: loop test} -setup {
font create c -underline 1
font create d -underline 1
font create e -underline 1
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
catch {font delete a d q c e b}
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
} -cleanup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -result {{a b c d e} {b c e}}
test font-7.4 {font command: delete: non-existent} -setup {
catch {font delete xyz}
@@ -435,29 +451,29 @@ test font-11.1 {font command: names: arguments} -body {
font names xyz
} -returnCodes error -result {wrong # args: should be "font names"}
test font-11.2 {font command: names: loop test: no passes} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
- font names
+ getnondefaultfonts
} -result {}
test font-11.3 {font command: names: loop test: one pass} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
font create
- font names
+ getnondefaultfonts
} -result {font1}
test font-11.4 {font command: names: loop test: multiple passes} -setup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -body {
font create xyz
font create abc
font create def
- lsort [font names]
+ lsort [getnondefaultfonts]
} -cleanup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -result {abc def xyz}
test font-11.5 {font command: names: skip deletePending fonts} -setup {
destroy .t.f
- catch {eval font delete [font names]}
+ clearnondefaultfonts
pack [label .t.f]
update
set x {}
@@ -465,12 +481,12 @@ test font-11.5 {font command: names: skip deletePending fonts} -setup {
# (nfPtr->deletePending == 0)
font create xyz
font create abc
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
.t.f config -font xyz
font delete xyz
- lappend x [font names]
+ lappend x [getnondefaultfonts]
} -cleanup {
- catch {eval font delete [font names]}
+ clearnondefaultfonts
} -result {{abc xyz} abc}
@@ -510,9 +526,9 @@ test font-13.1 {CreateNamedFont: new named font} -setup {
set x {}
} -body {
# not (new == 0)
- lappend x [font names]
+ lappend x [getnondefaultfonts]
font create xyz
- lappend x [font names]
+ lappend x [getnondefaultfonts]
} -cleanup {
font delete xyz
} -result {{} xyz}
@@ -647,7 +663,7 @@ test font-15.8 {Tk_AllocFontFromObj procedure: get native font} -constraints {
win
} -setup {
destroy .t.f
- catch {eval font delete [font names]}
+ clearnondefaultfonts
pack [label .t.f]
update
} -body {
@@ -753,7 +769,7 @@ test font-17.3 {Tk_FreeFont procedure: multiple ref} -setup {
} -result {-family fixed}
test font-17.4 {Tk_FreeFont procedure: named font} -setup {
destroy .t.f
- catch {eval font delete [font names]}
+ clearnondefaultfonts
pack [label .t.f]
update
} -body {
@@ -761,7 +777,7 @@ test font-17.4 {Tk_FreeFont procedure: named font} -setup {
font create xyz
.t.f config -font xyz
destroy .t.f
- font names
+ getnondefaultfonts
} -result {xyz}
test font-17.5 {Tk_FreeFont procedure: named font} -setup {
destroy .t.f
@@ -799,11 +815,11 @@ test font-18.1 {FreeFontObjProc} -constraints testfont -setup {
destroy .b1
set result {}
} -body {
- set x [format {Courier 12}]
+ set x [join {Courier 12} { }]
button .b1 -font $x
- set y [format {Courier 12}]
+ set y [join {Courier 12} { }]
.b1 configure -font $y
- set z [format {Courier 12}]
+ set z [join {Courier 12} { }]
.b1 configure -font $z
lappend result [testfont counts {Courier 12}]
set x red
@@ -1510,11 +1526,11 @@ test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body {
set x {}
.t.l config -text "000\t"
update
- lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}]
+ lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}]
lappend x [expr {[winfo reqheight .t.l] eq $ay}]
.t.l config -text "000\t00" -wrap [expr $ax * 6]
update
- lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}]
+ lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}]
lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
return $x
} -cleanup {
@@ -2346,6 +2362,16 @@ test font-46.5 {font actual, too many chars} -body {
font actual {times 10} 123456789012345678901234567890123456789012345678901
} -returnCodes error -result {expected a single character but got "1234567890123456789012345678901234567..."}
+test font-47.1 {Bug f214b8ad5b} -body {
+ interp create one
+ interp create two
+ load {} Tk one
+ load {} Tk two
+ one eval menu .menubar
+ two eval menu .menubar
+ interp delete one
+ interp delete two
+} -result {}
# cleanup
cleanupTests
generated by cgit v0.12 at 2024-11-05 04:45:34 (GMT)