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

Make TR tests work with contracts enabled.

Browse Source
This commit is contained in:
Eric Dobson 2014-03-10 20:58:17 -07:00
parent b205c99560
commit edc8bbf6b4
3 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
View File

@ -17,7 +17,7 @@
[(Values: (list (Result: ts _ _) ...)) (ret ts)] [(Values: (list (Result: ts _ _) ...)) (ret ts)]
[(ValuesDots: (list (Result: ts _ _) ...) dty dbound) [(ValuesDots: (list (Result: ts _ _) ...) dty dbound)
(ret ts (ret ts
(for/list ([t (in-list ts)]) -no-obj) (for/list ([t (in-list ts)]) -top-filter)
(for/list ([t (in-list ts)]) -empty-obj) (for/list ([t (in-list ts)]) -empty-obj)
dty dbound)] dty dbound)]
[_ (int-err "do-ret fails: ~a" t)])) [_ (int-err "do-ret fails: ~a" t)]))

2
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt
View File

@ -299,7 +299,7 @@
(-object #:method ((m (-> -Nat))) #:augment ((m (-> -Nat))))] (-object #:method ((m (-> -Nat))) #:augment ((m (-> -Nat))))]
[(-object #:method ((m (-> -Nat)) (n (-> -Nat)))) [(-object #:method ((m (-> -Nat)) (n (-> -Nat))))
(-object #:method ((m (-> -Nat))))] (-object #:method ((m (-> -Nat))))]
[(-object #:method ((f -Nat)) #:augment ((m (-> -Nat)) (n (-> -Nat)))) [(-object #:method ((f (-> -Nat))) #:augment ((m (-> -Nat)) (n (-> -Nat))))
(-object #:method ((m (-> -Nat))))] (-object #:method ((m (-> -Nat))))]
[(-object #:field ((a -Nat)) #:method ((m (-> -Nat)) (n (-> -Nat)))) [(-object #:field ((a -Nat)) #:method ((m (-> -Nat)) (n (-> -Nat))))
(-object #:method ((m (-> -Nat))))] (-object #:method ((m (-> -Nat))))]

6
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt
View File

@ -59,9 +59,9 @@
(check-prints-as? (-pair -String -Void) "(Pairof String Void)") (check-prints-as? (-pair -String -Void) "(Pairof String Void)")
(check-prints-as? (make-ListDots -Boolean 'x) "(List Boolean ... x)") (check-prints-as? (make-ListDots -Boolean 'x) "(List Boolean ... x)")
(check-prints-as? (make-F 'X) "X") (check-prints-as? (make-F 'X) "X")
(check-prints-as? (make-Values (list -String -Symbol)) (check-prints-as? (make-Values (list (-result -String) (-result -Symbol)))
"(values String Symbol)") "(values String Symbol)")
(check-prints-as? (make-ValuesDots (list -String -Symbol) (make-F 'x) 'x) (check-prints-as? (make-ValuesDots (list (-result -String) (-result -Symbol)) (make-F 'x) 'x)
"(values String Symbol x ... x)") "(values String Symbol x ... x)")
(check-prints-as? (-polydots (a b) (->... (list a) (b b) a)) (check-prints-as? (-polydots (a b) (->... (list a) (b b) a))
"(All (a b ...) (-> a b ... b a))") "(All (a b ...) (-> a b ... b a))")
@ -72,7 +72,7 @@
(-result -String -true-filter)))) (-result -String -true-filter))))
"(-> Input-Port (values (String : (Top | Bot)) (String : (Top | Bot))))") "(-> Input-Port (values (String : (Top | Bot)) (String : (Top | Bot))))")
(check-prints-as? (-> Univ (make-Values (list (-result -String -top-filter -empty-obj) (check-prints-as? (-> Univ (make-Values (list (-result -String -top-filter -empty-obj)
(-result -String -no-filter -no-obj)))) (-result -String -top-filter -empty-obj))))
"(-> Any (values String String))") "(-> Any (values String String))")
;; this case tests that the Number union is printed with its name ;; this case tests that the Number union is printed with its name
;; rather than its expansion (a former bug) ;; rather than its expansion (a former bug)