suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix arity reporting for chaperoned procedures and some primitives

Browse Source 
such as `for-each'
This commit is contained in:
Matthew Flatt 2011-04-08 07:54:36 -06:00
parent 3dda2492c2
commit 2dcd76f609
2 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/tests/racket/procs.rktl
View File

@ -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))))

4
src/racket/src/error.c
View File

@ -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;