From 7ceb48aa5a0bf07c4042d4efd79e95df3146ae16 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Wed, 2 Apr 2014 22:40:54 -0700 Subject: [PATCH] Remove a special case for NoFilter/NoObject in check below. original commit: c4f497bf2b01c974b81cb56a1d845a6132081e99 --- .../typed-racket/typecheck/check-below.rkt | 10 +--------- .../unit-tests/check-below-tests.rkt | 20 +++++++++++++++++++ 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt index d10950d5..bfbfbb7f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt @@ -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)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt index 24f858e7..689ea87d 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt @@ -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