Sometimes update is not enough, and you just have to wait.

1 files changed, 39 insertions, 23 deletions

diff --git a/tests/image.test b/tests/image.test
index 6a2c731..7744465 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -12,6 +12,24 @@ namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
+#
+# This procedure is used to make sure that a test image has
+# actually been displayed from inside the [NSView drawRect] method.
+if {[tk windowingsystem] == "aqua"} {
+    proc imageWait {} {
+	# Allow the display proc to fail and trigger drawRect.
+	update idletasks;
+	# Wait a bit for drawRect to actually be run.
+	set timeout 0;
+	after 200 {set timeout 1};
+	vwait timeout
+    }
+} else {
+    proc imageWait {} {
+	update;
+    }
+}
+
 imageInit
 
 # Canvas used in some tests in the whole file
@@ -33,14 +51,14 @@ test image-1.4 {Tk_ImageCmd procedure, "create" option} -body {
     image c bad_type
 } -returnCodes error -result {image type "bad_type" doesn't exist}
 test image-1.5 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
+    testImageType
 } -body {
     list [image create test myimage] [imageNames]
 } -cleanup {
     imageCleanup
 } -result {myimage myimage}
 test image-1.6 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -53,7 +71,7 @@ test image-1.6 {Tk_ImageCmd procedure, "create" option} -constraints {
 } -result {1}
 
 test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -63,14 +81,13 @@ test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints {
     update
     set x {}
     image create test myimage -variable x
-    update idletasks
-    update
+    imageWait
     return $x
 } -cleanup {
     imageCleanup
 } -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
 test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
-	testImageType 
+	testImageType
 } -setup {
     .c delete all
     imageCleanup
@@ -89,12 +106,12 @@ test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
     imageCleanup
 } -result {{myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
 test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints {
-	testImageType 
+	testImageType
 } -body {
     image create test -badName foo
 } -returnCodes error -result {bad option name "-badName"}
 test image-1.10 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
+    testImageType
 } -body {
     catch {image create test -badName foo}
     imageNames
@@ -143,7 +160,7 @@ test image-2.1 {Tk_ImageCmd procedure, "delete" option} -body {
     image delete
 } -result {}
 test image-2.2 {Tk_ImageCmd procedure, "delete" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
     set result {}
@@ -157,7 +174,7 @@ test image-2.2 {Tk_ImageCmd procedure, "delete" option} -constraints {
     imageCleanup
 } -result {{img2 myimage} {}}
 test image-2.3 {Tk_ImageCmd procedure, "delete" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -168,7 +185,7 @@ test image-2.3 {Tk_ImageCmd procedure, "delete" option} -constraints {
     imageCleanup
 } -returnCodes error -result {image "gorp" doesn't exist}
 test image-2.4 {Tk_ImageCmd procedure, "delete" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -191,7 +208,7 @@ test image-3.3 {Tk_ImageCmd procedure, "height" option} -body {
     image height foo
 } -returnCodes error -result {image "foo" doesn't exist}
 test image-3.4 {Tk_ImageCmd procedure, "height" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -208,7 +225,7 @@ test image-4.1 {Tk_ImageCmd procedure, "names" option} -body {
     image names x
 } -returnCodes error -result {wrong # args: should be "image names"}
 test image-4.2 {Tk_ImageCmd procedure, "names" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     catch {interp delete testinterp}
 } -body {
@@ -250,7 +267,7 @@ test image-5.3 {Tk_ImageCmd procedure, "type" option} -body {
 } -returnCodes error -result {image "foo" doesn't exist}
 
 test image-5.4 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -260,7 +277,7 @@ test image-5.4 {Tk_ImageCmd procedure, "type" option} -constraints {
     imageCleanup
 } -result {test}
 test image-5.5 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -272,7 +289,7 @@ test image-5.5 {Tk_ImageCmd procedure, "type" option} -constraints {
     imageCleanup
 } -returnCodes error -result {image "myimage" doesn't exist}
 test image-5.6 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testOldImageType 
+    testOldImageType
 } -setup {
     imageCleanup
 } -body {
@@ -282,7 +299,7 @@ test image-5.6 {Tk_ImageCmd procedure, "type" option} -constraints {
     imageCleanup
 } -result {oldtest}
 test image-5.7 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testOldImageType 
+    testOldImageType
 } -setup {
     .c delete all
     imageCleanup
@@ -301,7 +318,7 @@ test image-6.1 {Tk_ImageCmd procedure, "types" option} -body {
     image types x
 } -returnCodes error -result {wrong # args: should be "image types"}
 test image-6.2 {Tk_ImageCmd procedure, "types" option} -constraints {
-    testImageType 
+    testImageType
 } -body {
     lsort [image types]
 } -result {bitmap oldtest photo test}
@@ -317,7 +334,7 @@ test image-7.3 {Tk_ImageCmd procedure, "width" option} -body {
     image width foo
 } -returnCodes error -result {image "foo" doesn't exist}
 test image-7.4 {Tk_ImageCmd procedure, "width" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
 } -body {
@@ -331,7 +348,7 @@ test image-7.4 {Tk_ImageCmd procedure, "width" option} -constraints {
 
 
 test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints {
-    testImageType 
+    testImageType
 } -setup {
     imageCleanup
     set res {}
@@ -362,8 +379,7 @@ test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
     update
     set x {}
     foo changed 5 6 7 8 30 15
-    update idletasks
-    update
+    imageWait
     return $x
 } -cleanup {
     .c delete all
@@ -627,7 +643,7 @@ test image-15.1 {deleting image does not make widgets forget about it} -setup {
     .c delete all
     imageCleanup
 } -result {10 10 20 20 foo {} {10 10 30 30} foo}
-    
+
 destroy .c
 imageFinish