Fix contract build.

This commit is contained in:
Vincent St-Amour 2015-09-11 11:37:42 -05:00
parent 2e0cc095c7
commit 5ed30d7fcf
3 changed files with 19 additions and 17 deletions

View File

@ -11,6 +11,7 @@
racket/match racket/list
racket/contract
racket/lazy-require
racket/promise
(for-syntax racket/base syntax/parse))
(provide Mu-name:

View File

@ -41,10 +41,11 @@
;; The `check-thunk` argument serves the same purpose as in tc/letrec-values
(define/cond-contract (do-check expr->type namess expected-results exprs body expected
[check-thunk void])
((syntax? tc-results/c . -> . any/c)
(listof (listof identifier?)) (listof (listof tc-result?))
(listof syntax?) syntax? (or/c #f tc-results/c)
. -> .
(((syntax? tc-results/c . -> . any/c)
(listof (listof identifier?)) (listof (listof tc-result?))
(listof syntax?) syntax? (or/c #f tc-results/c))
((-> any/c))
. ->* .
tc-results/c)
(with-cond-contract t/p ([expected-types (listof (listof Type/c))]
[objs (listof (listof Object?))]

View File

@ -138,35 +138,35 @@
(->optkey Univ [-String] #:rest -String #:x -String #t -Void))
(string-append "(case-> (->* (Path-String) (String) Void) "
"(->* (Any #:x String) (String) #:rest String Void))"))
(check-prints-as? (make-Unit null null null -String)
(check-prints-as? (make-Unit null null null (-values (list -String)))
"(Unit (import) (export) (init-depend) String)")
;; Setup for slightly more complex unit printing test
(let* ([a^ (make-Signature #'a^ #f null)]
[a-sub^ (make-Signature #'a-sub^ a^ (list (cons #'a -String)))]
[a-sub^ (make-Signature #'a-sub^ #'a^ (list (cons #'a -String)))]
[b^ (make-Signature #'b^ #f (list (cons #'b -Integer)))]
[c^ (make-Signature #'c^ #f (list (cons #'c -Symbol)))]
[d^ (make-Signature #'d^ #f (list (cons #'d -String)))])
(check-prints-as? (make-Unit (list a^) null null -String)
(check-prints-as? (make-Unit (list a^) null null (-values (list -String)))
"(Unit (import a^) (export) (init-depend) String)")
(check-prints-as? (make-Unit (list a^) (list b^) null -String)
(check-prints-as? (make-Unit (list a^) (list b^) null (-values (list -String)))
"(Unit (import a^) (export b^) (init-depend) String)")
(check-prints-as? (make-Unit (list a^) (list b^) (list a^) -String)
(check-prints-as? (make-Unit (list a^) (list b^) (list a^) (-values (list -String)))
"(Unit (import a^) (export b^) (init-depend a^) String)")
(check-prints-as? (make-Unit (list a-sub^) null null -String)
(check-prints-as? (make-Unit (list a-sub^) null null (-values (list -String)))
"(Unit (import a-sub^) (export) (init-depend) String)")
(check-prints-as? (make-Unit (list a-sub^) null (list a-sub^) -String)
(check-prints-as? (make-Unit (list a-sub^) null (list a-sub^) (-values (list -String)))
"(Unit (import a-sub^) (export) (init-depend a-sub^) String)")
(check-prints-as? (make-Unit null (list a-sub^) null -String)
(check-prints-as? (make-Unit null (list a-sub^) null (-values (list -String)))
"(Unit (import) (export a-sub^) (init-depend) String)")
(check-prints-as? (make-Unit (list a^ b^) (list c^ d^) null -String)
(check-prints-as? (make-Unit (list a^ b^) (list c^ d^) null (-values (list -String)))
"(Unit (import a^ b^) (export c^ d^) (init-depend) String)")
(check-prints-as? (make-Unit (list a^ b^) null null -String)
(check-prints-as? (make-Unit (list a^ b^) null null (-values (list -String)))
"(Unit (import a^ b^) (export) (init-depend) String)")
(check-prints-as? (make-Unit null (list c^ d^) null -String)
(check-prints-as? (make-Unit null (list c^ d^) null (-values (list -String)))
"(Unit (import) (export c^ d^) (init-depend) String)")
(check-prints-as? (make-Unit (list a^ b^) (list c^ d^) (list b^) -String)
(check-prints-as? (make-Unit (list a^ b^) (list c^ d^) (list b^) (-values (list -String)))
"(Unit (import a^ b^) (export c^ d^) (init-depend b^) String)")
(check-prints-as? (make-Unit (list a^ b^) (list c^ d^) (list b^ a^) -String)
(check-prints-as? (make-Unit (list a^ b^) (list c^ d^) (list b^ a^) (-values (list -String)))
"(Unit (import a^ b^) (export c^ d^) (init-depend b^ a^) String)"))
(check-prints-as? (make-UnitTop) "UnitTop"))
(test-suite