procedure-arity: fix bug in non-JIT mode

The arity calculation for a `case-lambda` as a `prop:procedure`
argument did not drop the self argument as it should.
This commit is contained in:
Matthew Flatt 2018-08-10 09:11:17 -06:00
parent 696e9143a6
commit c05b9409d5
2 changed files with 8 additions and 1 deletions

View File

@ -42,6 +42,11 @@
(define (f1:a?:b? x #:a [a 0] #:b [b 1]) (list x a b))
(define (f1+:a:b? x #:a a #:b [b 1] . args) (list* x a b args))
(define (f1+:a?:b? x #:a [a 0] #:b [b 1] . args) (list* x a b args))
(define (f1+2:a:b x [y #f] #:a a #:b b) (if y
(if (number? x)
(list x y a b)
(list y a b))
(list x a b)))
(define f_ (case-lambda))
(define f_1_2 (case-lambda
[(x) (list x)]
@ -89,6 +94,8 @@
(,(wrap-m f1+:a/drop) ,(make-arity-at-least 0) (#:a) (#:a))
(,(wrap-m f1+:a?/drop) ,(make-arity-at-least 0) () (#:a))
(,(procedure->method (wrap f1+:a?)) ,(make-arity-at-least 1) () (#:a) #t)
(,f1+2:a:b (1 2) (#:a #:b) (#:a #:b))
(,(wrap-m f1+2:a:b) (0 1) (#:a #:b) (#:a #:b))
(,f0:a:b 0 (#:a #:b) (#:a #:b))
(,f0:a?:b 0 (#:b) (#:a #:b))
(,f1:a:b 1 (#:a #:b) (#:a #:b))

View File

@ -1880,7 +1880,7 @@ static Scheme_Object *get_or_check_arity(Scheme_Object *p, intptr_t a, Scheme_Ob
}
if ((a == -1) || (a == -3) || (a == -4)) {
if (drop && (a == -4))
if (drop)
mask = shift_for_drop(mask, drop);
if (a != -4)
return mask_to_arity(mask, a);