Tk tests that create images need to be independent of the interpreter environment.

1 files changed, 36 insertions, 0 deletions

diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 0750d7a..ac32852 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -138,6 +138,42 @@ namespace eval tk {
             focus -force .focus.e
             destroy .focus
 	}
+
+
+        namespace export imageInit imageFinish imageCleanup imageNames
+        variable ImageNames
+        proc imageInit {} {
+            variable ImageNames
+            if {![info exists ImageNames]} {
+                set ImageNames [lsort [image names]]
+            }
+            imageCleanup
+            if {[lsort [image names]] ne $ImageNames} {
+                return -code error "IMAGE NAMES mismatch: [image names] != $ImageNames"
+            }
+        }
+        proc imageFinish {} {
+            variable ImageNames
+            if {[lsort [image names]] ne $ImageNames} {
+                return -code error "images remaining: [image names] != $ImageNames"
+            }
+            imageCleanup
+        }
+        proc imageCleanup {} {
+            variable ImageNames
+            foreach img [image names] {
+                if {$img ni $ImageNames} {image delete $img}
+            }
+        }
+        proc imageNames {} {
+            variable ImageNames
+            set r {}
+            foreach img [image names] {
+                if {$img ni $ImageNames} {lappend r $img}
+            }
+            return $r
+        }
+
     }
 }