the Utah refactoring accidentally nested queue-callback; closes PR11500

collects/2htdp/private/world.rkt

@@ -219,6 +219,7 @@
           ;; responsiveness (where too many updates might not get 
           ;; through if the canvas is mostly in suspended-refresh 
           ;; mode for scene changes):
+          #;
           (send c flush)))
       
       ;; ----------------------------------------------------------------------
@@ -345,11 +346,13 @@
           (stop! (if re-raise e (send world get)))))
       
       (define/public (start!)
-        (queue-callback
-         (lambda ()
-           (with-handlers ([exn? (handler #t)])
-             (when draw (show-canvas))
-             (when register (register-with-host))))))
+        (with-handlers ([exn? (handler #t)])
+          (when draw (show-canvas))
+          (when register (register-with-host))
+          (define w (send world get))
+          (cond
+            [(stop w) (stop! w)]
+            [(stop-the-world? w) (stop! (stop-the-world-world w))])))
       
       (define/public (stop! w)
         (set! live #f)
@@ -358,11 +361,7 @@
       ;; -------------------------------------------------------------------------
       ;; initialize the world and run 
       (super-new)
-      (start!)
-      (let ([w (send world get)])
-        (cond
-          [(stop w) (stop! w)]
-          [(stop-the-world? w) (stop! (stop-the-world-world w))]))))))
+      (start!)))))
 
 ; (define make-new-world (new-world world%))
 

collects/2htdp/tests/record.rkt

@@ -37,5 +37,5 @@
     (error 'record? "(~s, ~s) didn't record proper number of images: ~s" n dir 
            number-of-png)))
 
-(create-n-images 3 4 "images3/")
+(create-n-images 3 3 "images3/")
 (create-n-images 0 0 "images0/")

collects/2htdp/tests/stop-when-crash.rkt

@@ -0,0 +1,42 @@
+#lang racket
+
+(require 2htdp/universe 2htdp/image)
+
+(with-handlers ((exn:fail? void))
+  (big-bang 0
+            (on-draw (λ _ (empty-scene 500 500)))
+            (stop-when (λ _ (car '())))))
+
+#| -----------------------------------------------------------------------------
+(struct:object:...tdp/private/last.rkt:8:2
+ `#<procedure:...p-when-crash.rkt:6:19>
+ #(struct:object:checked-cell% ...) 
+ #f
+ #<custodian>
+ #<procedure:...p-when-crash.rkt:6:19> 
+ #f 
+ 501
+ 501
+ #<procedure:void>
+ #<procedure:void>
+ #(struct:object:pasteboard% ...) 
+ #f
+ #<procedure:K>
+ #f
+ #f
+ #<procedure:...p-when-crash.rkt:7:21> 
+ #f
+ 0
+ #f
+ #f
+ #f
+ #<procedure:True>
+ #f
+ #f
+ #f
+ #<procedure:show-canvas>
+ #f
+ #<procedure:set-draw#!>
+ 1 
+ #<procedure:handler> ...)
+|#

collects/2htdp/tests/xtest

@@ -1,37 +1,39 @@
 #!/bin/tcsh
 
 gracket bad-draw.rkt
-echo "--- bad-draw.rkt ---" echo ""
+echo "done:--- bad-draw.rkt ---" echo ""
 racket batch-io.rkt 
-echo "--- batch-io.rkt  ---" echo ""
+echo "done:--- batch-io.rkt  ---" echo ""
 gracket clause-once.rkt
-echo "--- clause-once.rkt ---" echo ""
+echo "done:--- clause-once.rkt ---" echo ""
 gracket full-scene-visible.rkt 
-echo "--- full-scene-visible.rkt  ---" echo ""
+echo "done:--- full-scene-visible.rkt  ---" echo ""
 gracket image-equality-performance-htdp.rkt 
-echo "--- image-equality-performance-htdp.rkt  ---" echo ""
+echo "done:--- image-equality-performance-htdp.rkt  ---" echo ""
 gracket image-equality-performance.rkt 
-echo "--- image-equality-performance.rkt  ---" echo ""
+echo "done:--- image-equality-performance.rkt  ---" echo ""
 gracket mouse-evt.rkt 
-echo "--- mouse-evt.rkt  ---" echo ""
+echo "done:--- mouse-evt.rkt  ---" echo ""
 gracket on-tick-defined.rkt 
-echo "--- on-tick-defined.rkt  ---" echo ""
+echo "done:--- on-tick-defined.rkt  ---" echo ""
 gracket perform-robby.rkt 
-echo "--- perform-robby.rkt  ---" echo ""
+echo "done:--- perform-robby.rkt  ---" echo ""
 gracket profile-robby.rkt 
-echo "--- profile-robby.rkt  ---" echo ""
+echo "done:--- profile-robby.rkt  ---" echo ""
 gracket release.rkt
-echo "--- release.rkt ---" echo ""
+echo "done:--- release.rkt ---" echo ""
 gracket stop.rkt 
-echo "--- stop.rkt  ---" echo ""
+echo "done:--- stop.rkt  ---" echo ""
 gracket test-image.rkt 
-echo "--- test-image.rkt  ---" echo ""
+echo "done:--- test-image.rkt  ---" echo ""
 gracket ufo-rename.rkt 
-echo "--- ufo-rename.rkt  ---" echo ""
+echo "done:--- ufo-rename.rkt  ---" echo ""
 gracket world0-stops.rkt 
-
-echo "--- record.rkt  ---" echo ""
+echo "done:--- world0-stops.rkt  ---" echo ""
 gracket record.rkt 
-echo "--- record-stop-when.rkt  ---" echo ""
+echo "done:--- record.rkt  ---" echo ""
 gracket record-stop-when.rkt 
+echo "done:--- record-stop-when.rkt  ---" echo ""
 
+gracket stop-when-crash.rkt 
+echo "done:--- stop-when-crash.rkt  ---" echo ""

collects/2htdp/universe.rkt

@@ -341,4 +341,3 @@
     (parameterize ([current-eventspace esp])
       (queue-callback (lambda () (channel-put obj:ch (o)))))
     (send (channel-get obj:ch) last)))
-