[280089486e] Remove damaging effects of font.test. Thanks to fvogel.

1 files changed, 39 insertions, 20 deletions

diff --git a/tests/font.test b/tests/font.test
index c7574d7..a02cc2e 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -15,9 +15,28 @@ toplevel .b
 wm geom .b +0+0
 update idletasks
 
+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
+    }
+}
+
 proc setup {} {
     catch {destroy .b.f}
-    catch {eval font delete [font names]}
+    clearnondefaultfonts
     label .b.f 
     pack .b.f
     update
@@ -193,20 +212,20 @@ test font-6.1 {font command: create: make up name} {
     # (objc < 3) so name = NULL
     setup
     font create
-    font names
-} {font1}
+    expr {"font1" in [font names]}
+} {1}
 test font-6.2 {font command: create: name specified} {
     # not (objc < 3)
     setup
     font create xyz
-    font names
-} {xyz}
+    expr {"xyz" in [font names]}
+} {1}
 test font-6.3 {font command: create: name not really specified} {
     # (name[0] == '-') so name = NULL
     setup
     font create -family xyz
-    font names
-} {font1}
+    expr {"font1" in [font names]}
+} {1}
 test font-6.4 {font command: create: generate name} {
     # (name == NULL)
     setup
@@ -247,9 +266,9 @@ test font-7.2 {font command: delete: loop test} {
     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]]
 } {{a b c d e} d}
 test font-7.3 {font command: delete: loop test} {
     # (namedHashPtr == NULL) in middle of loop
@@ -260,9 +279,9 @@ test font-7.3 {font command: delete: loop test} {
     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]]
 } {{a b c d e} {b c e}}
 test font-7.4 {font command: delete: non-existent} {
     # (namedHashPtr == NULL) 
@@ -382,19 +401,19 @@ test font-11.1 {font command: names: arguments} {
 } {1 {wrong # args: should be "font names"}}
 test font-11.2 {font command: names: loop test: no passes} {
     setup
-    font names
+    getnondefaultfonts
 } {}
 test font-11.3 {font command: names: loop test: one pass} {
     setup
     font create
-    font names
+    getnondefaultfonts
 } {font1}
 test font-11.4 {font command: names: loop test: multiple passes} {
     setup
     font create xyz
     font create abc
     font create def
-    lsort [font names]
+    lsort [getnondefaultfonts]
 } {abc def xyz}
 test font-11.5 {font command: names: skip deletePending fonts} {
     # (nfPtr->deletePending == 0)
@@ -402,10 +421,10 @@ test font-11.5 {font command: names: skip deletePending fonts} {
     set x {}
     font create xyz
     font create abc
-    lappend x [lsort [font names]]
+    lappend x [lsort [getnondefaultfonts]]
     .b.f config -font xyz
     font delete xyz
-    lappend x [font names]
+    lappend x [getnondefaultfonts]
 } {{abc xyz} abc}
 
 test font-12.1 {UpdateDependantFonts procedure: no users} {
@@ -432,9 +451,9 @@ test font-13.1 {CreateNamedFont: new named font} {
     # not (new == 0)
     setup
     set x {}
-    lappend x [font names]
+    lappend x [getnondefaultfonts]
     font create xyz
-    lappend x [font names]
+    lappend x [getnondefaultfonts]
 } {{} xyz}
 test font-13.2 {CreateNamedFont: named font already exists} {
     # (new == 0)
@@ -586,8 +605,8 @@ test font-17.4 {Tk_FreeFont procedure: named font} {
     font create xyz
     .b.f config -font xyz
     destroy .b.f
-    font names
-} {xyz}
+    expr {"xyz" in [font names]}
+} {1}
 test font-17.5 {Tk_FreeFont procedure: named font} {
     # not (fontPtr->refCount == 0) 
     setup