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

fix keyword argument order bug in ->i

Browse Source 
the bug required all mandatory arguments to manifest

closes PR 15267
This commit is contained in:
Robby Findler 2016-03-08 21:15:43 -06:00
parent 26d28a28fe
commit 0f73870a1b
2 changed files with 44 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-test/tests/racket/contract/arrow-i.rkt
View File

@ -929,6 +929,14 @@
3 2 1) 3 2 1)
3) 3)
(test/spec-passed/result
'->i54
'((contract (->i (#:one [one any/c] #:two [two any/c] #:three [three any/c]) any)
(λ (#:one one #:two two #:three three) (list one two three))
'pos 'neg)
#:one 1 #:two 2 #:three 3)
'(1 2 3))
(test/pos-blame (test/pos-blame
'->i-arity1 '->i-arity1
'(contract (->i ([x number?]) () any) (λ () 1) 'pos 'neg)) '(contract (->i ([x number?]) () any) (λ () 1) 'pos 'neg))

80
racket/collects/racket/contract/private/arr-i.rkt
View File

@ -480,31 +480,33 @@ evaluted left-to-right.)
(define-for-syntax (args/vars->arg-checker result-checkers args rst vars this-param) (define-for-syntax (args/vars->arg-checker result-checkers args rst vars this-param)
(let ([opts? (ormap arg-optional? args)] (let ([opts? (ormap arg-optional? args)]
[this-params (if this-param (list this-param) '())]) [this-params (if this-param (list this-param) '())])
(define arg->var (make-hash))
(define kwd-args (filter arg-kwd args))
(define non-kwd-args (filter (λ (x) (not (arg-kwd x))) args))
(for ([arg (in-list args)]
[var (in-vector vars)])
(hash-set! arg->var arg var))
(define sorted-kwd/arg-pairs
(sort
(map (λ (arg) (cons (arg-kwd arg) (hash-ref arg->var arg))) kwd-args)
(λ (x y) (keyword<? (syntax-e (car x)) (syntax-e (car y))))))
(define keyword-arguments (map cdr sorted-kwd/arg-pairs))
(define regular-arguments (map (λ (arg) (hash-ref arg->var arg)) non-kwd-args))
(cond (cond
[(and opts? (ormap arg-kwd args)) [(and opts? (ormap arg-kwd args))
(let* ([arg->var (make-hash)] ;; has both optional and keyword args
[kwd-args (filter arg-kwd args)] #`(keyword-return/no-unsupplied
[non-kwd-args (filter (λ (x) (not (arg-kwd x))) args)]) #,(if (null? result-checkers) #f (car result-checkers))
'#,(map car sorted-kwd/arg-pairs)
(for ([arg (in-list args)] (list #,@keyword-arguments)
[var (in-vector vars)]) #,(if rst
(hash-set! arg->var arg var)) #'rest-args
#''())
(let ([sorted-kwd/arg-pairs #,@this-params
(sort #,@regular-arguments)]
(map (λ (arg) (cons (arg-kwd arg) (hash-ref arg->var arg))) kwd-args)
(λ (x y) (keyword<? (syntax-e (car x)) (syntax-e (car y)))))])
;; has both optional and keyword args
#`(keyword-return/no-unsupplied
#,(if (null? result-checkers) #f (car result-checkers))
'#,(map car sorted-kwd/arg-pairs)
(list #,@(map cdr sorted-kwd/arg-pairs))
#,(if rst
#'rest-args
#''())
#,@this-params
#,@(map (λ (arg) (hash-ref arg->var arg)) non-kwd-args))))]
[opts? [opts?
;; has optional args, but no keyword args ;; has optional args, but no keyword args
#`(return/no-unsupplied #,(if (null? result-checkers) #f (car result-checkers)) #`(return/no-unsupplied #,(if (null? result-checkers) #f (car result-checkers))
@ -516,27 +518,17 @@ evaluted left-to-right.)
(all-but-last (vector->list vars)) (all-but-last (vector->list vars))
(vector->list vars)))] (vector->list vars)))]
[else [else
(let*-values ([(rev-regs rev-kwds) (cond
(for/fold ([regs null] [(and (null? keyword-arguments) rst)
[kwds null]) #`(apply values #,@result-checkers #,@this-params #,@regular-arguments rest-args)]
([arg (in-list args)] [(null? keyword-arguments)
[i (in-naturals)]) #`(values #,@result-checkers #,@this-params #,@regular-arguments)]
(if (arg-kwd arg) [rst
(values regs (cons (vector-ref vars i) kwds)) #`(apply values #,@result-checkers (list #,@keyword-arguments)
(values (cons (vector-ref vars i) regs) kwds)))] #,@this-params #,@regular-arguments rest-args)]
[(regular-arguments keyword-arguments) [else
(values (reverse rev-regs) (reverse rev-kwds))]) #`(values #,@result-checkers (list #,@keyword-arguments)
(cond #,@this-params #,@regular-arguments)])])))
[(and (null? keyword-arguments) rst)
#`(apply values #,@result-checkers #,@this-params #,@regular-arguments rest-args)]
[(null? keyword-arguments)
#`(values #,@result-checkers #,@this-params #,@regular-arguments)]
[rst
#`(apply values #,@result-checkers (list #,@keyword-arguments)
#,@this-params #,@regular-arguments rest-args)]
[else
#`(values #,@result-checkers (list #,@keyword-arguments)
#,@this-params #,@regular-arguments)]))])))
(define (return/no-unsupplied res-checker rest-args . args) (define (return/no-unsupplied res-checker rest-args . args)
(if res-checker (if res-checker