From 14cd4ae26c662e642b5ce14c7ea300746b9b2b31 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@ccs.neu.edu>
Date: Fri, 15 Jul 2011 11:47:42 -0400
Subject: [PATCH] fixed bug in exception handling for drawing; Closes PR 12044
 (cherry picked from commit 562252f5892420ca27dccf2e1c6f853629d3668d)

---
 collects/2htdp/private/world.rkt       |  8 ++++++--
 collects/2htdp/tests/bad-draw.rkt      |  9 ++++-----
 collects/2htdp/tests/error-in-draw.rkt | 16 ++++++++++++++++
 collects/2htdp/tests/error-in-tick.rkt | 17 +++++++++++++++++
 collects/2htdp/tests/xtest             |  2 ++
 5 files changed, 45 insertions(+), 7 deletions(-)
 create mode 100644 collects/2htdp/tests/error-in-draw.rkt
 create mode 100644 collects/2htdp/tests/error-in-tick.rkt

diff --git a/collects/2htdp/private/world.rkt b/collects/2htdp/private/world.rkt
index 7099212e7e..c311430896 100644
--- a/collects/2htdp/private/world.rkt
+++ b/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 '()) 
diff --git a/collects/2htdp/tests/bad-draw.rkt b/collects/2htdp/tests/bad-draw.rkt
index 793cbdab91..2846f66f36 100644
--- a/collects/2htdp/tests/bad-draw.rkt
+++ b/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)))))
           
diff --git a/collects/2htdp/tests/error-in-draw.rkt b/collects/2htdp/tests/error-in-draw.rkt
new file mode 100644
index 0000000000..c37782036e
--- /dev/null
+++ b/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"))
diff --git a/collects/2htdp/tests/error-in-tick.rkt b/collects/2htdp/tests/error-in-tick.rkt
new file mode 100644
index 0000000000..3156ac3a6e
--- /dev/null
+++ b/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"))
diff --git a/collects/2htdp/tests/xtest b/collects/2htdp/tests/xtest
index 25463109d2..90f598586c 100755
--- a/collects/2htdp/tests/xtest
+++ b/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