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

Remove a special case for NoFilter/NoObject in check below.

Browse Source
This commit is contained in:
Eric Dobson 2014-04-02 22:40:54 -07:00
parent beb981e2af
commit c4f497bf2b
2 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
View File

@ -104,6 +104,7 @@
(define (filter-better? f1 f2) (define (filter-better? f1 f2)
(match* (f1 f2) (match* (f1 f2)
[(f f) #t] [(f f) #t]
[(f (NoFilter:)) #t]
[((FilterSet: f1+ f1-) (FilterSet: f2+ f2-)) [((FilterSet: f1+ f1-) (FilterSet: f2+ f2-))
(and (implied-atomic? f2+ f1+) (and (implied-atomic? f2+ f1+)
(implied-atomic? f2- f1-))] (implied-atomic? f2- f1-))]
@ -121,15 +122,6 @@
[((tc-result1: (? (lambda (t) (type-equal? t (Un))))) _) [((tc-result1: (? (lambda (t) (type-equal? t (Un))))) _)
(fix-results expected)] (fix-results expected)]
[((tc-results: ts fs os) (tc-results: ts2 (NoFilter:) (NoObject:)))
(unless (= (length ts) (length ts2))
(value-mismatch tr1 expected))
(unless (for/and ([t (in-list ts)] [s (in-list ts2)]) (subtype t s))
(expected-but-got (stringify ts2) (stringify ts)))
(if (= (length ts) (length ts2))
(ret ts2 fs os)
(ret ts2))]
[((tc-result1: t1 f1 o1) (tc-result1: t2 f2 o2)) [((tc-result1: t1 f1 o1) (tc-result1: t2 f2 o2))
(cond (cond
[(not (subtype t1 t2)) [(not (subtype t1 t2))

20
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt
View File

@ -165,6 +165,26 @@
(test-below (ret -Symbol -true-filter -empty-obj Univ 'B) tc-any-results (test-below (ret -Symbol -true-filter -empty-obj Univ 'B) tc-any-results
#:result (ret -Symbol -true-filter -empty-obj Univ 'B)) #:result (ret -Symbol -true-filter -empty-obj Univ 'B))
(test-below
(ret -Symbol)
(ret -Symbol -no-filter -empty-obj)
#:result (ret -Symbol -top-filter -empty-obj))
(test-below
(ret -Symbol -true-filter)
(ret -Symbol -no-filter -empty-obj)
#:result (ret -Symbol -true-filter -empty-obj))
(test-below #:fail
(ret -Symbol -true-filter)
(ret (list Univ -Symbol) (list -no-filter -top-filter))
#:result (ret (list Univ -Symbol) (list -top-filter -top-filter)))
(test-below
(ret (list Univ) (list -true-filter) (list -empty-obj))
(ret Univ -no-filter)
#:result (ret (list Univ) (list -true-filter) (list -empty-obj)))
;; Enable these once check-below is fixed ;; Enable these once check-below is fixed
;; Currently does not fail ;; Currently does not fail