From 6d3a4588477a6f6197d69a96db17066a00df27ca Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 9 Feb 2012 16:49:03 -0700
Subject: [PATCH] fix reported arity of `map' et al.

Closes PR 12561
---
 collects/racket/private/map.rkt    | 8 ++++----
 collects/tests/racket/basic.rktl   | 5 +++++
 collects/tests/racket/testing.rktl | 1 +
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/collects/racket/private/map.rkt b/collects/racket/private/map.rkt
index 3aadf114d6..944351bcbe 100644
--- a/collects/racket/private/map.rkt
+++ b/collects/racket/private/map.rkt
@@ -40,7 +40,7 @@
                       [else (cons (f (car l1) (car l2)) 
                                   (loop (cdr l1) (cdr l2)))]))
                    (map f l1 l2))]
-              [(f . args) (apply map f args)])])
+              [(f l . args) (apply map f l args)])])
         map))
   
    (define for-each2
@@ -67,7 +67,7 @@
                       [else (begin (f (car l1) (car l2)) 
                                    (loop (cdr l1) (cdr l2)))]))
                    (for-each f l1 l2))]
-              [(f . args) (apply for-each f args)])])
+              [(f l . args) (apply for-each f l args)])])
         for-each))
 
    (define andmap2
@@ -98,7 +98,7 @@
                           [else (and (f (car l1) (car l2)) 
                                      (loop (cdr l1) (cdr l2)))])))
                    (andmap f l1 l2))]
-              [(f . args) (apply andmap f args)])])
+              [(f l . args) (apply andmap f l args)])])
         andmap))
 
    (define ormap2
@@ -129,5 +129,5 @@
                           [else (or (f (car l1) (car l2)) 
                                     (loop (cdr l1) (cdr l2)))])))
                    (ormap f l1 l2))]
-              [(f . args) (apply ormap f args)])])
+              [(f l . args) (apply ormap f l args)])])
         ormap))))
diff --git a/collects/tests/racket/basic.rktl b/collects/tests/racket/basic.rktl
index e503e0a9c8..5d49e1a8bd 100644
--- a/collects/tests/racket/basic.rktl
+++ b/collects/tests/racket/basic.rktl
@@ -1414,6 +1414,11 @@
 (test #f list-length '(a b . c))
 (test '() map cadr '())
 
+(arity-test map 2 -1)
+(arity-test for-each 2 -1)
+(arity-test andmap 2 -1)
+(arity-test ormap 2 -1)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; exceptions
 
diff --git a/collects/tests/racket/testing.rktl b/collects/tests/racket/testing.rktl
index 4ca3bfa17d..661a84b25e 100644
--- a/collects/tests/racket/testing.rktl
+++ b/collects/tests/racket/testing.rktl
@@ -283,6 +283,7 @@ transcript.
 			     (apply f args))])
 		    (printf "~s\n BUT EXPECTED ERROR\n" v)
 		    (record-error (list v 'Error (cons f args))))))])
+      (test #t aok? (procedure-arity f))
       (let loop ([n 0][l '()])
 	(unless (>= n min)
 	  (unless (memq n except)