From 6e022706b4d85876d3eb68d6bdbc2ee28c5c8362 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 21 Oct 2013 16:13:29 -0500
Subject: [PATCH] fix bug in 82bb5ba4c8; also add test case

---
 .../2htdp/private/clauses-spec-and-process.rkt  |  9 +++++++--
 .../htdp-test/2htdp/tests/error-in-draw.rkt     | 17 +++++++++++++++++
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/clauses-spec-and-process.rkt b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/clauses-spec-and-process.rkt
index 5054ddb81e..8a46db646e 100644
--- a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/clauses-spec-and-process.rkt
+++ b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/clauses-spec-and-process.rkt
@@ -36,7 +36,7 @@
   (syntax-rules ()
     [(_ arity)
      (lambda (tag)
-       (lambda (p)
+       (lambda (p [tag tag])
          (syntax-case p ()
            [(_ x) #`(proc> #,tag (f2h x) arity)]
            [_ (err tag p)])))]
@@ -95,7 +95,12 @@
                   (define n  (string->symbol (format "~a handler" (syntax-e (caar spec)))))
                   (syntax-property  i 'inferred-name n))]
                [else (loop (cdr spec))])))
-         (if r ((third s) r `',(car r)) (fourth s)))
+         (if r 
+             (let ([f (third s)])
+               (if (procedure-arity-includes? f 2)
+                   (f r `',(car r))
+                   (f r)))
+             (fourth s)))
        Spec))
 
 ;; check whether rec? occurs, produces list of keyword x clause pairs 
diff --git a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-in-draw.rkt b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-in-draw.rkt
index c37782036e..9b60fbbdb1 100644
--- a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-in-draw.rkt
+++ b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-in-draw.rkt
@@ -14,3 +14,20 @@
 (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"))
+
+
+(let ([exn (with-handlers ([exn:fail? values])
+             (big-bang #f 
+                       [to-draw (λ (a b) #f)])
+             "no error raised")])
+(unless (regexp-match #rx"^to-draw:" (exn-message exn))
+  (eprintf "expected a error message beginning with to-draw:\n")
+  (raise exn)))
+
+(let ([exn (with-handlers ([exn:fail? values])
+             (big-bang #f 
+                       [on-draw (λ (a b) #f)])
+             "no error raised")])
+(unless (regexp-match #rx"^on-draw:" (exn-message exn))
+  (eprintf "expected a error message beginning with on-draw:\n")
+  (raise exn)))