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

Fix contract generation for functions with optionals and keyword arguments.

Browse Source 
Closes PR13354.
This commit is contained in:
Vincent St-Amour 2012-12-17 13:53:21 -05:00
parent b715a6fed5
commit 8c66be33e7
2 changed files with 128 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

120
collects/tests/typed-racket/succeed/arrow-star-contracts.rkt Normal file
View File

@ -0,0 +1,120 @@
#lang racket/base
(require typed/rackunit)
(module defs typed/racket/base
(provide (all-defined-out))
(: foo0k (case-> ([#:kw Real] -> Real)))
(define (foo0k #:kw [kw 0])
kw)
(: foo01k (case-> ([#:kw Real] -> Real)
(Real [#:kw Real] -> Real)))
(define (foo01k [x 0] #:kw [kw 0])
(+ x kw))
(: foo012k (case-> ([#:kw Real] -> Real)
(Real [#:kw Real] -> Real)
(Real Real [#:kw Real] -> Real)))
(define (foo012k [x 0] [y 0] #:kw [kw 0])
(+ x y kw))
(: foo12k (case-> (Real [#:kw Real] -> Real)
(Real Real [#:kw Real] -> Real)))
(define (foo12k x [y 0] #:kw [kw 0])
(+ x y kw))
(: foo123k (case-> (Real [#:kw Real] -> Real)
(Real Real [#:kw Real] -> Real)
(Real Real Real [#:kw Real] -> Real)))
(define (foo123k x [y 0] [z 0] #:kw [kw 0])
(+ x y z kw))
(: foo23k (case-> (Real Real [#:kw Real] -> Real)
(Real Real Real [#:kw Real] -> Real)))
(define (foo23k x y [z 0] #:kw [kw 0])
(+ x y z kw))
(: foo234k (case-> (Real Real [#:kw Real] -> Real)
(Real Real Real [#:kw Real] -> Real)
(Real Real Real Real [#:kw Real] -> Real)))
(define (foo234k x y [z 0] [w 0] #:kw [kw 0])
(+ x y z w kw))
)
(require 'defs)
(void foo0k)
(void foo01k)
(void foo12k)
(check-equal? (foo0k) 0)
(check-exn exn:fail:contract? (λ () (foo0k 1)))
(check-equal? (foo0k #:kw 10) 10)
(check-exn exn:fail:contract? (λ () (foo0k 1 #:kw 10)))
(check-equal? (foo01k) 0)
(check-equal? (foo01k 1) 1)
(check-exn exn:fail:contract? (λ () (foo01k 1 1)))
(check-equal? (foo01k #:kw 10) 10)
(check-equal? (foo01k 1 #:kw 10) 11)
(check-exn exn:fail:contract? (λ () (foo01k 1 1 #:kw 10)))
(check-exn exn:fail:contract? (λ () (foo12k)))
(check-equal? (foo12k 1) 1)
(check-equal? (foo12k 1 1) 2)
(check-exn exn:fail:contract? (λ () (foo12k 1 1 1)))
(check-exn exn:fail:contract? (λ () (foo12k #:kw 10)))
(check-equal? (foo12k 1 #:kw 10) 11)
(check-equal? (foo12k 1 1 #:kw 10) 12)
(check-exn exn:fail:contract? (λ () (foo12k 1 1 1 #:kw 10)))
(void foo012k)
(void foo123k)
(void foo23k)
(void foo234k)
(check-equal? (foo012k) 0)
(check-equal? (foo012k 1) 1)
(check-equal? (foo012k 1 1) 2)
(check-exn exn:fail:contract? (λ () (foo012k 1 1 1)))
(check-equal? (foo012k #:kw 10) 10)
(check-equal? (foo012k 1 #:kw 10) 11)
(check-equal? (foo012k 1 1 #:kw 10) 12)
(check-exn exn:fail:contract? (λ () (foo012k 1 1 1 #:kw 10)))
(check-exn exn:fail:contract? (λ () (foo123k)))
(check-equal? (foo123k 1) 1)
(check-equal? (foo123k 1 1) 2)
(check-equal? (foo123k 1 1 1) 3)
(check-exn exn:fail:contract? (λ () (foo123k 1 1 1 1)))
(check-exn exn:fail:contract? (λ () (foo123k #:kw 10)))
(check-equal? (foo123k 1 #:kw 10) 11)
(check-equal? (foo123k 1 1 #:kw 10) 12)
(check-equal? (foo123k 1 1 1 #:kw 10) 13)
(check-exn exn:fail:contract? (λ () (foo123k 1 1 1 1 #:kw 10)))
(check-exn exn:fail:contract? (λ () (foo23k)))
(check-exn exn:fail:contract? (λ () (foo23k 1)))
(check-equal? (foo23k 1 1) 2)
(check-equal? (foo23k 1 1 1) 3)
(check-exn exn:fail:contract? (λ () (foo23k 1 1 1 1)))
(check-exn exn:fail:contract? (λ () (foo23k #:kw 10)))
(check-exn exn:fail:contract? (λ () (foo23k 1 #:kw 10)))
(check-equal? (foo23k 1 1 #:kw 10) 12)
(check-equal? (foo23k 1 1 1 #:kw 10) 13)
(check-exn exn:fail:contract? (λ () (foo23k 1 1 1 1 #:kw 10)))
(check-exn exn:fail:contract? (λ () (foo234k)))
(check-exn exn:fail:contract? (λ () (foo234k 1)))
(check-equal? (foo234k 1 1) 2)
(check-equal? (foo234k 1 1 1) 3)
(check-equal? (foo234k 1 1 1 1) 4)
(check-exn exn:fail:contract? (λ () (foo234k 1 1 1 1 1)))
(check-exn exn:fail:contract? (λ () (foo234k #:kw 10)))
(check-exn exn:fail:contract? (λ () (foo234k 1 #:kw 10)))
(check-equal? (foo234k 1 1 #:kw 10) 12)
(check-equal? (foo234k 1 1 1 #:kw 10) 13)
(check-equal? (foo234k 1 1 1 1 #:kw 10) 14)
(check-exn exn:fail:contract? (λ () (foo234k 1 1 1 1 1 #:kw 10)))

14
collects/typed-racket/private/type-contract.rkt
View File

@ -153,15 +153,17 @@
[(and
(> (length arrs) 1)
;; Keyword args, range and rest specs all the same.
(let ([xs (map (match-lambda [(arr: _ rng rest-spec _ kws)
(list rng rest-spec kws)])
arrs)])
(foldl equal? (first xs) (rest xs)))
(let* ([xs (map (match-lambda [(arr: _ rng rest-spec _ kws)
(list rng rest-spec kws)])
arrs)]
[first-x (first xs)])
(for/and ([x (in-list (rest xs))])
(equal? x first-x)))
;; Positionals are monotonically increasing by at most one.
(let-values ([(_ ok?)
(for/fold ([positionals '()]
(for/fold ([positionals (arr-dom (first arrs))]
[ok-so-far? #t])
([arr (in-list arrs)])
([arr (in-list (rest arrs))])
(match arr
[(arr: dom _ _ _ _)
(define ldom (length dom))