fixed bug in exception handling for drawing; Closes PR 12044

(cherry picked from commit 562252f589)

collects/2htdp/private/world.rkt

@@ -258,10 +258,14 @@
                  (pdraw))
                (queue-callback 
                 (lambda ()
-                  (with-handlers ([exn? (handler #t)])
+                  (define H (handler #t))
+                  (with-handlers ([exn? H])
                     ; (define tag (object-name transform))
                     (define nw (transform (send world get) arg ...))
-                    (define (d) (pdraw) (set-draw#!))
+                    (define (d) 
+                      (with-handlers ((exn? H))
+                        (pdraw))
+                      (set-draw#!))
                     ;; ---
                     ;; [Listof (Box [d | void])]
                     (define w '()) 

collects/2htdp/tests/bad-draw.rkt

@@ -2,11 +2,10 @@
 
 (require 2htdp/universe)
 
-(define s "")
-(define x 0)
+(define txt "expected to return a scene but this is a string")
 
-(with-handlers ((exn? (lambda _ "success!")))
+(with-handlers ((exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))))
   (big-bang 0
-            (on-tick (lambda (w) (begin (set! x (+ x 1)) w)))
-            (to-draw (lambda (w) (set! s (number->string w))))))
+            (on-tick add1)
+            (to-draw (lambda (w) (error txt)))))
           

collects/2htdp/tests/error-in-draw.rkt

@@ -0,0 +1,16 @@
+#lang racket
+
+(require 2htdp/universe)
+(require 2htdp/image)
+
+(define (f x)
+  (cond
+    [(= x 0) (circle 10 'solid 'red)]
+    [(= x 1) (circle 20 'solid 'red)]
+    [else (error txt)]))
+
+(define txt "all questions were #f")
+
+(with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))])
+  (big-bang 0 (on-tick add1) (to-draw f))
+  (error 'error-in-draw "test failed"))

collects/2htdp/tests/error-in-tick.rkt

@@ -0,0 +1,17 @@
+#lang racket
+
+(require 2htdp/universe)
+(require 2htdp/image)
+
+(define (f x) (circle 10 'solid 'red))
+
+(define (g x)
+  (cond
+    [(= x 0) 1]
+    [else (error txt)]))
+
+(define txt "all questions were #f")
+
+(with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))])
+  (big-bang 0 (on-tick g) (to-draw f))
+  (error 'error-in-tick "test failed"))

collects/2htdp/tests/xtest

@@ -9,6 +9,8 @@ run() {
 }
 
 run bad-draw.rkt
+run error-in-tick.rkt
+run error-in-draw.rkt
 run -t batch-io.rkt
 run clause-once.rkt
 run full-scene-visible.rkt