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

Fix arity checking for ->*.

Browse Source 
Some functions were passing when they shouldn't have, only to fail when
the function is called.

Technically not backwards compatible, but should only affect functions
that were never called.
This commit is contained in:
Vincent St-Amour 2016-03-18 12:34:26 -05:00
parent b94e77a062
commit 894873c2ff
2 changed files with 47 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/racket-test/tests/racket/contract/arrow-star.rkt
View File

@ -716,4 +716,20 @@
(test/spec-passed (test/spec-passed
'->*-opt-optional5 '->*-opt-optional5
'((contract (->* () integer? #:post #t) (lambda x 1) 'pos 'neg)))) '((contract (->* () integer? #:post #t) (lambda x 1) 'pos 'neg)))
(test/pos-blame
'->*-opt-vs-mand1
'(contract (->* (integer?) (symbol? boolean?) number?)
(lambda (x y [z #t])
x)
'pos
'neg))
(test/pos-blame
'->*-opt-vs-mand2
'(contract (->* () (symbol? boolean?) symbol?)
(lambda (y [z #t])
y)
'pos
'neg))
)

9
racket/collects/racket/contract/private/arity-checking.rkt
View File

@ -29,10 +29,13 @@
(define exra-required-args (if (ellipsis-rest-arg-ctc? ->stct-rest) (define exra-required-args (if (ellipsis-rest-arg-ctc? ->stct-rest)
(length (*list-ctc-suffix ->stct-rest)) (length (*list-ctc-suffix ->stct-rest))
0)) 0))
(define expected-number-of-non-keyword-args (+ (length ->stct-doms) exra-required-args))
;; the function must be ok for *all* the arities the contract says are ok
(for/and ([base-number-of-non-keyword-args (in-range ->stct-min-arity (add1 (length ->stct-doms)))])
(define expected-number-of-non-keyword-args (+ base-number-of-non-keyword-args exra-required-args))
(define matching-arity? (define matching-arity?
(and (for/or ([a (in-list arity)]) (and (for/or ([a (in-list arity)])
(or (equal? expected-number-of-non-keyword-args a) (or (and (equal? expected-number-of-non-keyword-args a))
(and (arity-at-least? a) (and (arity-at-least? a)
(>= expected-number-of-non-keyword-args (arity-at-least-value a))))) (>= expected-number-of-non-keyword-args (arity-at-least-value a)))))
(if ->stct-rest (if ->stct-rest
@ -54,7 +57,7 @@
" and arbitrarily many more" " and arbitrarily many more"
"") "")
val val
(arity-as-string val))))) (arity-as-string val))))))
(define (should-have-supplied kwd) (define (should-have-supplied kwd)
(k (k