From 2dcd76f6090d363b0669e8ce0ae6b09b546aa5d3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 8 Apr 2011 07:54:36 -0600
Subject: [PATCH] fix arity reporting for chaperoned procedures and some
 primitives  such as `for-each'

---
 collects/tests/racket/procs.rktl | 14 ++++++++++++++
 src/racket/src/error.c           |  4 ++++
 2 files changed, 18 insertions(+)

diff --git a/collects/tests/racket/procs.rktl b/collects/tests/racket/procs.rktl
index d549ee5df5..ad5060609e 100644
--- a/collects/tests/racket/procs.rktl
+++ b/collects/tests/racket/procs.rktl
@@ -70,6 +70,20 @@
     (for-each (lambda (p)
                 (let ([a (cadr p)])
                   (test a procedure-arity (car p))
+                  (when (number? a)
+                    (let ([rx (regexp (format "expects(| at least) ~a argument" 
+                                              (if (zero? a) "(0|no)" a)))]
+                          [bad-args (cons 'extra (for/list ([i (in-range a)]) 'a))])
+                      (test #t regexp-match? rx
+                            (with-handlers ([exn:fail? (lambda (exn)
+                                                         (exn-message exn))])
+                              (apply (car p) bad-args)))
+                      (unless (= a 1)
+                        (test #t regexp-match? rx
+                              (with-handlers ([exn:fail? (lambda (exn)
+                                                           (exn-message exn))])
+                                (for-each (car p) (list bad-args))
+                                "done!")))))
                   (test-values (list (caddr p) (cadddr p))
                                (lambda ()
                                  (procedure-keywords (car p))))
diff --git a/src/racket/src/error.c b/src/racket/src/error.c
index 3f395a8cf5..bdc6ea3b78 100644
--- a/src/racket/src/error.c
+++ b/src/racket/src/error.c
@@ -1229,6 +1229,10 @@ char *scheme_make_arity_expect_string(Scheme_Object *proc,
   int namelen = -1;
   int mina, maxa;
 
+  if (SCHEME_CHAPERONEP(proc)) {
+    proc = SCHEME_CHAPERONE_VAL(proc);
+  }
+
   if (SCHEME_PRIMP(proc)) {
     name = ((Scheme_Primitive_Proc *)proc)->name;
     mina = ((Scheme_Primitive_Proc *)proc)->mina;