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

original commit: c4f497bf2b01c974b81cb56a1d845a6132081e99
This commit is contained in:
Eric Dobson 2014-04-02 22:40:54 -07:00
parent 0dee5c804f
commit 7ceb48aa5a
2 changed files with 21 additions and 9 deletions

View File

@ -104,6 +104,7 @@
(define (filter-better? f1 f2)
(match* (f1 f2)
[(f f) #t]
[(f (NoFilter:)) #t]
[((FilterSet: f1+ f1-) (FilterSet: f2+ f2-))
(and (implied-atomic? f2+ f1+)
(implied-atomic? f2- f1-))]
@ -121,15 +122,6 @@
[((tc-result1: (? (lambda (t) (type-equal? t (Un))))) _)
(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))
(cond
[(not (subtype t1 t2))

View File

@ -165,6 +165,26 @@
(test-below (ret -Symbol -true-filter -empty-obj Univ 'B) tc-any-results
#: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
;; Currently does not fail